File: RELATIVE:/../../../mfix.git/model/init_namelist.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: INIT_NAMELIST                                           !
4     !  Purpose: initialize the NAMELIST variables                          !
5     !                                                                      !
6     !  Author: P. Nicoletti                               Date: 26-NOV-91  !
7     !                                                                      !
8     !  Keyword Documentation Format:                                       !
9     !                                                                      !
10     !<keyword category="category name" required="true"/FALSE               !
11     !                                    legacy=TRUE/FALSE>                !
12     !  <description></description>                                         !
13     !  <arg index="" id="" max="" min=""/>                                 !
14     !  <dependent keyword="" value="DEFINED"/>                             !
15     !  <conflict keyword="" value="DEFINED"/>                              !
16     !  <valid value="" note="" alias=""/>                                  !
17     !  <range min="" max="" />                                             !
18     !  MFIX_KEYWORD=INIT_VALUE                                             !
19     !</keyword>                                                            !
20     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
21     
22           SUBROUTINE INIT_NAMELIST
23     
24     !-----------------------------------------------
25     ! Modules
26     !-----------------------------------------------
27           USE param
28           USE param1
29           USE run
30           USE output
31           USE physprop
32           USE geometry
33           USE ic
34           USE bc
35           USE ps
36           USE fldvar
37           USE constant
38           USE indices
39           USE is
40           USE toleranc
41           USE scales
42           USE ur_facs
43           USE leqsol
44           USE residual
45           USE rxns
46           USE scalars
47           USE compar
48           USE parallel
49           USE cdist
50           USE stiff_chem
51           IMPLICIT NONE
52     !-----------------------------------------------
53     ! Local variables
54     !-----------------------------------------------
55     ! loop counters
56           INTEGER :: LC
57     
58     !#####################################################################!
59     !                             Run Control                             !
60     !#####################################################################!
61     
62     !<keyword category="Run Control" required="true">
63     !  <description> Name used to create output files. The name should
64     !    generate legal file names after appending extensions.
65     !    Ex: Given the input, RUN_NAME = "bub01", MFIX will generate
66     !    the output files: BUB01.LOG, BUB01.OUT, BUB01.RES, etc.
67     !  </description>
68           RUN_NAME = UNDEFINED_C
69     !</keyword>
70     
71     !<keyword category="Run Control" required="false">
72     !  <description>Problem description. Limited to 60 characters.</description>
73           DESCRIPTION = UNDEFINED_C
74     !</keyword>
75     
76     !<keyword category="Run Control" required="true">
77     !  <description> Simulation input/output units.</description>
78     !  <valid value="cgs" note="All input and output in CGS units (g, cm, s, cal)."/>
79     !  <valid value="si" note="All input and output in SI units (kg, m, s, J)."/>
80           UNITS = UNDEFINED_C
81     !</keyword>
82     
83     !<keyword category="Run Control" required="true">
84     !  <description>Type of run.</description>
85     !  <valid value="new" note="A new run. There should be no .RES, .SPx,
86     !    .OUT, or .LOG files in the run directory."/>
87     !  <valid value="RESTART_1" note="Traditional restart. The run continues
88     !    from the last time the .RES file was updated and new data is added
89     !    to the SPx files."/>
90     !  <valid value="RESTART_2"
91     !    note="Start a new run with initial conditions from a .RES file
92     !      created from another run. No other data files (SPx) should be
93     !      in the run directory."/>
94           RUN_TYPE = UNDEFINED_C
95     !</keyword>
96     
97     !<keyword category="Run Control" required="false">
98     !  <description>
99     !    Simulation start time. This is typically zero.
100     !  </description>
101     !  <range min="0.0" max="+Inf" />
102           TIME = UNDEFINED
103     !</keyword>
104     
105     !<keyword category="Run Control" required="false">
106     !  <description>
107     !    Simulation stop time.
108     !  </description>
109     !  <range min="0.0" max="+Inf" />
110           TSTOP = UNDEFINED
111     !</keyword>
112     
113     !<keyword category="Run Control" required="false">
114     !  <description>
115     !    Initial time step size. If left undefined, a steady-state
116     !    calculation is performed.
117     !  </description>
118     !  <dependent keyword="TIME" value="DEFINED"/>
119     !  <dependent keyword="TSTOP" value="DEFINED"/>
120     !  <range min="0.0" max="+Inf" />
121           DT = UNDEFINED
122     !</keyword>
123     
124     !<keyword category="Run Control" required="false">
125     !  <description>Maximum time step size.</description>
126     !  <dependent keyword="TIME" value="DEFINED"/>
127     !  <dependent keyword="TSTOP" value="DEFINED"/>
128     !  <range min="0.0" max="+Inf" />
129           DT_MAX = ONE
130     !</keyword>
131     
132     !<keyword category="Run Control" required="false">
133     !  <description>Minimum time step size.</description>
134     !  <dependent keyword="TIME" value="DEFINED"/>
135     !  <dependent keyword="TSTOP" value="DEFINED"/>
136     !  <range min="0.0" max="+Inf" />
137           DT_MIN = 1.0D-6
138     !</keyword>
139     
140     !<keyword category="Run Control" required="false">
141     !  <description>
142     !    Factor for adjusting time step.
143     !    * The value must be less than or equal to 1.0.
144     !    * A value of 1.0 keeps the time step constant which may help overcome
145     !      initial non-convergence.
146     !  </description>
147     !  <dependent keyword="TIME" value="DEFINED"/>
148     !  <dependent keyword="TSTOP" value="DEFINED"/>
149     !  <range min="0.0" max="1" />
150           DT_FAC = 0.9D0
151     !</keyword>
152     
153     !<keyword category="Run Control" required="false">
154     !  <description>
155     !    Force a forward time-step if the maximum number of iterations,
156     !    MAX_NIT, is reached. The forward time-step is only forced after
157     !    reaching the minimum time-step, DT_MIN, for adjustable time-step
158     !    simulations (DT_FAC /= 1). This option should be used with caution
159     !    as unconverged time-steps may lead to poor simulation results and/or
160     !    additional convergence issues.
161     !  </description>
162     !  <valid value=".TRUE." note="Force forward time-step when DT=DT_MIN and
163     !    the maximum number of iterations are reached."/>
164     !  <valid value=".FALSE." note="Abort run when DT < DT_MIN."/>
165           PERSISTENT_MODE = .FALSE.
166     !</keyword>
167     
168     !<keyword category="Run Control" required="false">
169     !  <description>
170     !    Flag to restart the code when DT < DT_MIN.
171     !  </description>
172           AUTO_RESTART = .FALSE.
173     !</keyword>
174     
175     !<keyword category="Run Control" required="false">
176     !  <description>
177     !    Flag to enable/disable solving the X-momentum equations.
178     !  </description>
179     !  <arg index="1" id="Phase" min="0" max="DIM_M"/>
180     !  <valid value=".TRUE." note="Solve X-momentum equations."/>
181     !  <valid value=".FALSE." note="The X velocity initial conditions
182     !   persist throughout the simulation."/>
183           MOMENTUM_X_EQ(:DIM_M) = .TRUE.
184     !</keyword>
185     
186     !<keyword category="Run Control" required="false">
187     !  <description>
188     !    Flag to enable/disable solving the Y-momentum equations.
189     ! </description>
190     !  <arg index="1" id="Phase" min="0" max="DIM_M"/>
191     !  <valid value=".TRUE." note="Solve Y-momentum equations."/>
192     !  <valid value=".FALSE." note="The Y velocity initial conditions
193     !   persist throughout the simulation."/>
194           MOMENTUM_Y_EQ(:DIM_M) = .TRUE.
195     !</keyword>
196     
197     !<keyword category="Run Control" required="false">
198     !  <description>
199     !    Flag to enable/disable solving the Z-momentum equations.
200     !  </description>
201     !  <arg index="1" id="Phase" min="0" max="DIM_M"/>
202     !  <valid value=".TRUE." note="Solve Z-momentum equations."/>
203     !  <valid value=".FALSE." note="The Z velocity initial conditions
204     !   persist throughout the simulation."/>
205           MOMENTUM_Z_EQ(:DIM_M) = .TRUE.
206     !</keyword>
207     
208     !<keyword category="Run Control" required="false">
209     !  <description>
210     !    Flag to enable Jackson form of momentum equations.
211     !    note="Anderson and Jackson, (1967), IECF, 6(4), p.527."/>
212     !  </description>
213     !  <valid value=".TRUE." note="Solve Jackson form of momentum equations."/>
214     !  <valid value=".FALSE." note="Default form."/>
215           JACKSON = .FALSE.
216     !</keyword>
217     
218     !<keyword category="Run Control" required="false">
219     !  <description>
220     !    Flag to enable Ishii form of momentum equations.
221     !    note="Ishii, (1975), Thermo-fluid dynamic theory of two-phase flow."/>
222     !  </description>
223     !  <valid value=".TRUE." note="Solve Ishii form of momentum equations."/>
224     !  <valid value=".FALSE." note="Default form."/>
225           ISHII = .FALSE.
226     !</keyword>
227     
228     !<keyword category="Run Control" required="false">
229     !  <description>Solve energy equations.</description>
230     !  <valid value=".TRUE." note="Solve energy equations."/>
231     !  <valid value=".FALSE." note="Do not solve energy equations."/>
232           ENERGY_EQ = .TRUE.
233     !</keyword>
234     
235     !<keyword category="Run Control" required="false">
236     !  <description>Solve species transport equations.</description>
237     !  <arg index="1" id="Phase" min="0" max="DIM_M"/>
238     !  <valid value=".TRUE." note="Solve species equations."/>
239     !  <valid value=".FALSE." note="Do not solve species equations."/>
240           SPECIES_EQ(:DIM_M) = .TRUE.
241     !</keyword>
242     
243     !<keyword category="Run Control" required="false" tfm="true">
244     !  <description>Granular energy formulation selection.</description>
245     !  <valid value=".FALSE."
246     !    note="Use algebraic granular energy equation formulation."/>
247     !  <valid value=".TRUE."
248     !    note="Use granular energy transport equation (PDE) formulation."/>
249           GRANULAR_ENERGY = .FALSE.
250     !</keyword>
251     
252     !<keyword category="Run Control" required="false">
253     !  <description>
254     !    The K-Epsilon turbulence model (for single-phase flow).
255     !    o Numerical parameters (like under-relaxation) are the same as the
256     !      ones for SCALAR (index = 9).
257     !    o All walls must be defined (NSW, FSW or PSW) in order to use
258     !      standard wall functions. If a user does not specify a wall type,
259     !      the simulation will not contain the typical turbulent profile in
260     !      wall-bounded flows.
261     !  </description>
262     !  <dependent keyword="MU_GMAX" value="DEFINED"/>
263     !  <conflict keyword="L_SCALE0" value="DEFINED"/>
264     !  <valid value=".TRUE."  note="Enable the K-epsilon turbulence model
265     !    (for single-phase flow) using standard wall functions."/>
266     !  <valid value=".FALSE." note="Do not use K-epsilon turbulence model"/>
267           K_EPSILON = .FALSE.
268     !</keyword>
269     
270     !<keyword category="Run Control" required="false">
271     !  <description>
272     !    Value of turbulent length initialized. This may be overwritten
273     !    in specific regions with the keyword IC_L_SCALE.
274     !</description>
275     !  <dependent keyword="MU_GMAX" value="DEFINED"/>
276     !  <conflict keyword="K_EPSILON" value=".TRUE."/>
277           L_SCALE0 = ZERO
278     !</keyword>
279     
280     !<keyword category="Run Control" required="false">
281     !  <description>
282     !    Maximum value of the turbulent viscosity of the fluid, which
283     !    must be defined if any turbulence model is used.
284     !    A value MU_GMAX =1.E+03 is recommended. (see calc_mu_g.f)
285     !  </description>
286           MU_GMAX = UNDEFINED
287     !</keyword>
288     
289     !<keyword category="Run Control" required="false">
290     !  <description>
291     !     Available gas-solids drag models.
292     !     Note: The extension _PCF following the specified drag model
293     !     indicates that the polydisperse correction factor is available.
294     !     For PCF details see:
295     !     o Van der Hoef MA, Beetstra R, Kuipers JAM. (2005)
296     !       Journal of Fluid Mechanics.528:233-254.
297     !     o Beetstra, R., van der Hoef, M. A., Kuipers, J.A.M. (2007).
298     !       AIChE Journal, 53:489-501.
299     !     o Erratum (2007), AIChE Journal, Volume 53:3020
300     !  </description>
301     !
302     !  <valid value="SYAM_OBRIEN" note="Syamlal M, OBrien TJ (1988).
303     !   International Journal of Multiphase Flow 14:473-481.
304     !   Two additional parameters may be specified: DRAG_C1, DRAG_D1"/>
305     !
306     !  <valid value="GIDASPOW" note="Ding J, Gidaspow D (1990).
307     !   AIChE Journal 36:523-538"/>
308     !
309     !  <valid value="GIDASPOW_BLEND" note="Lathouwers D, Bellan J (2000).
310     !    Proceedings of the 2000 U.S. DOE
311     !        Hydrogen Program Review NREL/CP-570-28890."/>
312     !
313     !  <valid value="WEN_YU" note="Wen CY, Yu YH (1966).
314     !   Chemical Engineering Progress Symposium Series 62:100-111."/>
315     !
316     !  <valid value="KOCH_HILL" note="Hill RJ, Koch DL, Ladd JC (2001).
317     !   Journal of Fluid Mechanics, 448: 213-241. and 448:243-278."/>
318     !
319     !  <valid value="BVK" note="Beetstra, van der Hoef, Kuipers (2007).
320     !   Chemical Engineering Science 62:246-255"/>
321     !
322     !  <valid value="HYS" note="Yin, X, Sundaresan, S. (2009).
323     !   AIChE Journal 55:1352-1368
324     !   This model has a lubrication cutoff distance, LAM_HYS, that can be
325     !   specified."/>
326     !
327     !  <valid value="USER_DRAG" note="Invoke user-defined drag law. (usr_drag.f)"/>
328     !
329     !  <valid value="GIDASPOW_PCF" note="see GIDASPOW"/>
330     !  <valid value="GIDASPOW_BLEND_PCF" note="see GIDASPOW_BLEND"/>
331     !  <valid value="WEN_YU_PCF" note="see WEN_YU"/>
332     !  <valid value="KOCH_HILL_PCF" note="see KOCH_HILL"/>
333     !
334           DRAG_TYPE = 'SYAM_OBRIEN'
335     !</keyword>
336     
337     !<keyword category="Run Control" required="false">
338     !  <description>
339     !    Quantity for calibrating Syamlal-O'Brien drag correlation using Umf
340     !    data.  This is determined using the Umf spreadsheet.
341     !  </description>
342           DRAG_C1 = 0.8d0
343     !</keyword>
344     
345     !<keyword category="Run Control" required="false">
346     !  <description>
347     !    Quantity for calibrating Syamlal-O'Brien drag correlation using Umf
348     !    data.  This is determined using the Umf spreadsheet.
349     !  </description>
350           DRAG_D1 = 2.65d0
351     !</keyword>
352     
353     !<keyword category="Run Control" required="false">
354     !  <description>
355     !    The lubrication cutoff distance for HYS drag model.  In practice
356     !    this number should be on the order of the mean free path of the
357     !    gas for smooth particles, or the RMS roughness of a particle if
358     !    they are rough (if particle roughness is larger than the mean
359     !   free path).
360     !  </description>
361     !  <dependent keyword="DRAG_TYPE" value="HYS"/>
362           LAM_HYS = UNDEFINED
363     !</keyword>
364     
365     !<keyword category="Run Control" required="false" tfm="true">
366     !  <description>
367     !    Subgrid models.
368     !  </description>
369     !
370     !  <valid value="Igci" note="
371     !   Igci, Y., Pannala, S., Benyahia, S., and Sundaresan S. (2012).
372     !   Industrial & Engineering Chemistry Research, 2012, 51(4):2094-2103"/>
373     !
374     !  <valid value="Milioli" note="
375     !   Milioli, C.C., Milioli, F. E., Holloway, W., Agrawal, K. and
376     !   Sundaresan, S. (2013). AIChE Journal, 59:3265-3275."/>
377     !
378           SUBGRID_TYPE = UNDEFINED_C
379     !</keyword>
380     
381     !<keyword category="Run Control" required="false" tfm="true">
382     !  <description>
383     !    Ratio of filter size to computational cell size.
384     !  </description>
385           FILTER_SIZE_RATIO = 2.0D0
386     !</keyword>
387     
388     !<keyword category="Run Control" required="false" tfm="true">
389     !  <description>Flag for subgrid wall correction.</description>
390     !  <valid value=".FALSE." note="Do not include wall correction."/>
391     !  <valid value=".TRUE." note="Include subgrid wall correction."/>
392           SUBGRID_Wall = .FALSE.
393     !</keyword>
394     
395     !<keyword category="Run Control" required="false">
396     !  <description>
397     !    Shared gas-pressure formulation. See Syamlal, M. and Pannala, S.
398     !    "Multiphase continuum formulation for gas-solids reacting flows,"
399     !    chapter in Computational Gas-Solids Flows and Reacting Systems:
400     !    Theory, Methods and Practice, S. Pannala, M. Syamlal and T.J.
401     !    O'Brien (editors), IGI Global, Hershey, PA, 2011.
402     !  </description>
403     !  <valid value=".FALSE." note="Use Model A"/>
404     !  <valid value=".TRUE."  note="Use Model B. Bouillard, J.X.,
405     !    Lyczkowski, R.W., Folga, S., Gidaspow, D., Berry, G.F. (1989).
406     !    Canadian Journal of Chemical Engineering 67:218-229."/>
407           MODEL_B = .FALSE.
408     !</keyword>
409     
410     !<keyword category="Run Control" required="false">
411     !  <description> The number of user-defined scalar transport equations
412     !    to solve.
413     !  </description>
414     !  <range min="0" max="DIM_SCALAR" />
415           NScalar = 0
416     !</keyword>
417     
418     !<keyword category="Run Control" required="false">
419     !  <description>
420     !    The phase convecting the indexed scalar transport equation.
421     !  </description>
422     !  <arg index="1" id="Scalar Equation" min="0" max="DIM_SCALAR"/>
423     !  <range min="0" max="DIM_M" />
424           Phase4Scalar(:DIM_SCALAR) = UNDEFINED_I
425     !</keyword>
426     
427     !<keyword category="Run Control" required="false">
428     !  <description>
429     !    MFIX checks for messages generated by the GUI during runtime.
430     !  </description>
431     !      INTERACTIVE_MODE = .FALSE.
432     !</keyword>
433     
434     
435     !<keyword category="Run Control" required="false">
436     !  <description>
437     !    Defines when to interupt a simulation because the time-step has
438     !    been reduced too frequently. This is only applicable when running
439     !    in INTERACTIVE_MODE. By default, a simulation is intrupted when
440     !    3 of the past 5 time-steps resulted in a reduced time step size.
441     !    o IDX=1: Number of observed time-step reductions [3].
442     !    o IDX=2: Size of observation window (time-steps) [5].
443     !  <arg index="1" id="IDX" min="1" max="2"/>
444     !  </description>
445           TIMESTEP_FAIL_RATE(1) = 3
446           TIMESTEP_FAIL_RATE(2) = 5
447     !</keyword>
448     
449     
450     !#####################################################################!
451     !                           Physical Parameters                       !
452     !#####################################################################!
453     
454     
455     !<keyword category="Physical Parameters" required="false">
456     !  <description>Reference pressure. [0.0]</description>
457           P_REF = ZERO
458     !</keyword>
459     
460     !<keyword category="Physical Parameters" required="false">
461     !  <description>Scale factor for pressure. [1.0]</description>
462           P_SCALE = ONE
463     !</keyword>
464     
465     !<keyword category="Physical Parameters" required="false">
466     !  <description>Gravitational acceleration. [980.7 in CGS]</description>
467           GRAVITY = UNDEFINED
468     !</keyword>
469     
470     !<keyword category="Physical Parameters" required="false">
471     !  <description>
472     !    X-component of gravitational acceleration vector. By default, the
473     !    gravity force acts in the negative y-direction.
474     !  </description>
475           GRAVITY_X = ZERO
476     !</keyword>
477     
478     !<keyword category="Physical Parameters" required="false">
479     !  <description>
480     !    Y-component of gravitational acceleration vector. By default, the
481     !    gravity force acts in the negative y-direction.
482     !  </description>
483           GRAVITY_Y = ZERO
484     !</keyword>
485     
486     !<keyword category="Physical Parameters" required="false">
487     !  <description>
488     !    Z-component of gravitational acceleration vector. By default, the
489     !    gravity force acts in the negative y-direction.
490     !  </description>
491           GRAVITY_Z = ZERO
492     !</keyword>
493     
494     
495     
496     
497     
498     !#####################################################################!
499     !                          Numerical Parameters                       !
500     !#####################################################################!
501     
502     
503     
504     !<keyword category="Numerical Parameters" required="false">
505     !  <description>
506     !    Maximum number of iterations [500].
507     !  </description>
508           MAX_NIT = 500
509     !</keyword>
510     
511     !<keyword category="Numerical Parameters" required="false">
512     !  <description>
513     !    Factor to normalize the gas continuity equation residual. The
514     !    residual from the first iteration is used if NORM_G is left
515     !    undefined. NORM_G=0 invokes a normalization method based on the
516     !    dominant term in the continuity equation. This setting may speed up
517     !    calculations, especially near a steady state and incompressible
518     !    fluids. But, the number of iterations for the gas phase pressure
519     !    should be increased, LEQ_IT(1), to ensure mass balance
520     !  </description>
521           NORM_G = UNDEFINED
522     !</keyword>
523     
524     !<keyword category="Numerical Parameters" required="false">
525     !  <description>
526     !    Factor to normalize the solids continuity equation residual. The
527     !    residual from the first iteration is used if NORM_S is left
528     !    undefined. NORM_S = 0 invokes a normalization method based on the
529     !    dominant term in the continuity equation. This setting may speed up
530     !    calculations, especially near a steady state and incompressible
531     !    fluids. But, the number of iterations for the solids volume
532     !    fraction should be increased, LEQ_IT(2), to ensure mass balance.
533     !  </description>
534           NORM_S = UNDEFINED
535     !</keyword>
536     
537     !<keyword category="Numerical Parameters" required="false">
538     !  <description>
539     !    Maximum residual at convergence (Continuity + Momentum) [1.0d-3].
540     !  </description>
541           TOL_RESID = 1.0D-3
542     !</keyword>
543     
544     
545     !<keyword category="Numerical Parameters" required="false">
546     !  <description>
547     !    Maximum residual at convergence (Energy) [1.0d-4].
548     !  </description>
549           TOL_RESID_T = 1.0D-4
550     !</keyword>
551     
552     !<keyword category="Numerical Parameters" required="false">
553     !  <description>
554     !    Maximum residual at convergence (Species Balance) [1.0d-4].
555     !  </description>
556           TOL_RESID_X = 1.0D-4
557     !</keyword>
558     
559     !<keyword category="Numerical Parameters" required="false">
560     !  <description>
561     !    Maximum residual at convergence (Granular Energy) [1.0d-4].
562     !  </description>
563           TOL_RESID_Th = 1.0D-4
564     !</keyword>
565     
566     !<keyword category="Numerical Parameters" required="false">
567     !  <description>
568     !    Maximum residual at convergence (Scalar Equations) [1.0d-4].
569     !  </description>
570           TOL_RESID_Scalar = 1.0D-4
571     !</keyword>
572     
573     !<keyword category="Numerical Parameters" required="false">
574     !  <description>
575     !    Maximum residual at convergence (K_Epsilon Model) [1.0d-4].
576     !  </description>
577           TOL_RESID_K_Epsilon = 1.0D-4
578     !</keyword>
579     
580     !<keyword category="Numerical Parameters" required="false">
581     !  <description>
582     !    Minimum residual for declaring divergence [1.0d+4].
583     !    This parameter is useful for incompressible fluid simulations
584     !    because velocity residuals can take large values for the second
585     !    iteration (e.g., 1e+8) before dropping down to smaller values for
586     !    the third iteration.
587     !  </description>
588           TOL_DIVERGE = 1.0D+4
589     !</keyword>
590     
591     !<keyword category="Numerical Parameters" required="false">
592     !  <description>
593     !    Reduce the time step if the residuals stop decreasing. Disabling this
594     !    feature may help overcome initial non-convergence.
595     !  </description>
596     !  <valid value=".FALSE." note="Continue iterating if residuals stall."/>
597     !  <valid value=".TRUE."  note="Reduce time step if residuals stall."/>
598           DETECT_STALL = .TRUE.
599     !</keyword>
600     
601     
602     !<keyword category="Numerical Parameters" required="false">
603     !  <description>
604     !    LEQ Solver selection. BiCGSTAB is the default method for all
605     !    equation types.
606     !  </description>
607     !  <arg index="1" id="Equation ID Number" min="1" max="DIM_EQS"/>
608     !  <valid value="1" note="SOR - Successive over-relaxation"/>
609     !  <valid value="2" note="BiCGSTAB - Biconjugate gradient stabilized."/>
610     !  <valid value="3" note="GMRES - Generalized minimal residual method"/>
611     !  <valid value="5" note="CG - Conjugate gradient"/>
612           LEQ_METHOD(:) = 2
613     !</keyword>
614     
615     !<keyword category="Numerical Parameters" required="false">
616     !  <description>
617     !    Linear Equation tolerance [1.0d-4].
618     !  </description>
619     !  <arg index="1" id="Equation ID Number" min="1" max="DIM_EQS"/>
620     !  <dependent keyword="LEQ_METHOD" value="2"/>
621     !  <dependent keyword="LEQ_METHOD" value="3"/>
622           LEQ_TOL(:) = 1.0D-4
623     !</keyword>
624     
625     !<keyword category="Numerical Parameters" required="false">
626     !  <description>
627     !    Number of iterations in the linear equation solver.
628     !    o 20 iterations for equation types 1-2
629     !    o  5 iterations for equation types 3-5,10
630     !    o 15 iterations for equation types 6-9
631     !  </description>
632     !  <arg index="1" id="Equation ID Number" min="1" max="DIM_EQS"/>
633           LEQ_IT(1) =  20
634           LEQ_IT(2) =  20
635           LEQ_IT(3) =   5
636           LEQ_IT(4) =   5
637           LEQ_IT(5) =   5
638           LEQ_IT(6) =  15
639           LEQ_IT(7) =  15
640           LEQ_IT(8) =  15
641           LEQ_IT(9) =  15
642           LEQ_IT(10) =  5
643     !</keyword>
644     
645     !<keyword category="Numerical Parameters" required="false">
646     !  <description>
647     !    Linear equation sweep direction. This applies when using GMRES or
648     !    when using the LINE preconditioner with BiCGSTAB or CG methods.
649     !    'RSRS' is the default for all equation types.
650     !  </description>
651     !  <arg index="1" id="Equation ID Number" min="1" max="DIM_EQS"/>
652     !  <valid value="RSRS" note="(Red/Black Sweep, Send Receive) repeated twice"/>
653     !  <valid value="ISIS" note="(Sweep in I, Send Receive) repeated twice"/>
654     !  <valid value="JSJS" note="(Sweep in J, Send Receive) repeated twice"/>
655     !  <valid value="KSKS" note="(Sweep in K, Send Receive) repeated twice"/>
656     !  <valid value="ASAS" note="(All Sweep, Send Receive) repeated twice"/>
657           LEQ_SWEEP(:) = 'RSRS'
658     !</keyword>
659     
660     !<keyword category="Numerical Parameters" required="false">
661     !  <description>
662     !    Linear precondition used by the BiCGSTAB and CG LEQ solvers. 'LINE'
663     !    is the default for all equation types.
664     !  </description>
665     !  <arg index="1" id="Equation ID Number" min="1" max="DIM_EQS"/>
666     !  <valid value="NONE" note="No preconditioner"/>
667     !  <valid value="LINE" note="Line relaxation"/>
668     !  <valid value="DIAG" note="Diagonal Scaling"/>
669           LEQ_PC(:) = 'LINE'
670     !</keyword>
671     
672     
673     !<keyword category="Numerical Parameters" required="false">
674     !  <description>
675     !    Under relaxation factors.
676     !    o 0.8 for equation types 1,9
677     !    o 0.5 for equation types 2,3,4,5,8
678     !    o 1.0 for equation types 6,7,10
679     !  </description>
680     !  <arg index="1" id="Equation ID Number" min="1" max="DIM_EQS"/>
681           UR_FAC(1)  = 0.8D0     ! pressure
682           UR_FAC(2)  = 0.5D0     ! rho, ep
683           UR_FAC(3)  = 0.5D0     ! U
684           UR_FAC(4)  = 0.5D0     ! V
685           UR_FAC(5)  = 0.5D0     ! W
686           UR_FAC(6)  = 1.0D0     ! T
687           UR_FAC(7)  = 1.0D0     ! X
688           UR_FAC(8)  = 0.5D0     ! Th
689           UR_FAC(9)  = 0.8D0     ! Scalar
690           UR_FAC(10) = 1.0D0     ! DES Diffusion
691     !</keyword>
692     
693     !<keyword category="Numerical Parameters" required="false">
694     !  <description>
695     !    The implicitness calculation of the gas-solids drag coefficient
696     !    may be underrelaxed by changing ur_f_gs, which takes values
697     !    between 0 to 1.
698     !    o  0 updates F_GS every time step
699     !    o  1 updates F_GS every iteration
700     !  </description>
701     !  <range min="0" max="1" />
702           UR_F_gs = 1.0D0
703     !</keyword>
704     
705     !<keyword category="Numerical Parameters" required="false">
706     !  <description>
707     !    Under relaxation factor for conductivity coefficient associated
708     !    with other solids phases for IA Theory [1.0].
709     !  </description>
710           UR_Kth_sml = 1.0D0
711     !</keyword>
712     
713     !<keyword category="Numerical Parameters" required="false">
714     !  <description>Discretization scheme of equations.</description>
715     !  <arg index="1" id="Equation ID Number" min="1" max="DIM_EQS"/>
716     !  <valid value="0" note="First-order upwinding."/>
717     !  <valid value="1" note="First-order upwinding (using down-wind factors)."/>
718     !  <valid value="3" note="Smart."/>
719     !  <valid value="2" note="Superbee (recommended method)."/>
720     !  <valid value="5" note="QUICKEST (does not work)."/>
721     !  <valid value="4" note="ULTRA-QUICK."/>
722     !  <valid value="7" note="van Leer."/>
723     !  <valid value="6" note="MUSCL."/>
724     !  <valid value="8" note="minmod."/>
725     !  <valid value="9" note="Central (often unstable; useful for testing)."/>
726           DISCRETIZE(:) = 0
727     !</keyword>
728     
729     !<keyword category="Numerical Parameters" required="false">
730     !  <description>
731     !    Use deferred correction method for implementing higher order
732     !    discretization.
733     !  </description>
734     !  <valid value=".FALSE." note="Use down-wind factor method (default)."/>
735     !  <valid value=".TRUE."  note="Use deferred correction method."/>
736           DEF_COR  =  .FALSE.
737     !</keyword>
738     
739     !<keyword category="Numerical Parameters" required="false">
740     !  <description>
741     !    This scheme guarantees that the set of differenced species mass
742     !    balance equations maintain the property that the sum of species
743     !    mass fractions sum to one. This property is not guaranteed when
744     !    a flux limiter is used with higher order spatial discretization
745     !    schemes. Note: The chi-scheme is implemented for SMART and MUSCL
746     !    discretization schemes.
747     !    Darwish, M.S., Moukalled, F. (2003). Computer Methods in Applied
748     !    Mech. Eng., 192(13):1711-1730.
749     !  </description>
750     !  <valid value=".FALSE." note="Do not use the chi-scheme."/>
751     !  <valid value=".TRUE."  note="Use the chi-scheme correction."/>
752           Chi_scheme = .FALSE.
753     !</keyword>
754     
755     !<keyword category="Numerical Parameters" required="false">
756     !  <description>
757     !    Four point fourth order interpolation and is upstream biased.
758     !    Notes:
759     !    o DISCRETIZE(*) defaults to Superbee if this scheme is chosen
760     !      and DISCRETIZE(*) < 2.
761     !    o Set C_FAC between 0 and 1 when using this scheme.
762     !  </description>
763     !  <dependent keyword="C_FAC" value="DEFINED"/>
764     !  <valid value=".FALSE." note="Do not use fourth order interpolation."/>
765     !  <valid value=".TRUE."  note="Use fourth order interpolation."/>
766           FPFOI = .FALSE.
767     !</keyword>
768     
769     !<keyword category="Numerical Parameters" required="false">
770     !  <description>
771     !    Factor between zero and one used in the universal limiter when
772     !    using four point, fourth order interpolation (FPFOI).
773     !    o Choosing one gives (diffusive) first order upwinding.
774     !    o The scheme becomes more compressive as values near zero.
775     !  </description>
776     !  <range min="0.0" max="1.0" />
777     !  <dependent keyword="fpfoi" value=".TRUE."/>
778           C_FAC = UNDEFINED
779     !</keyword>
780     
781     !<keyword category="Numerical Parameters" required="false">
782     !  <description>Temporal discretization scheme.</description>
783     !  <valid value=".FALSE."
784     !    note="Implicit Euler based temporal discretization scheme employed
785     !      (first order accurate in time)."/>
786     !  <valid value=".TRUE."
787     !    note="Two-step implicit Runge-Kutta method based temporal
788     !      discretization scheme employed. This method should be second
789     !      order accurate in time excluding pressure terms and restart
790     !      time step which are first order accurate. However, recent testing
791     !      shows that second order accuracy in time is not observed."/>
792           CN_ON = .FALSE.
793     !</keyword>
794     
795     !<keyword category="Numerical Parameters" required="false">
796     !  <description>
797     !    The code declares divergence if the velocity anywhere in the domain
798     !    exceeds a maximum value.  This maximum value is automatically
799     !    determined from the boundary values. The user may scale the maximum
800     !    value by adjusting this scale factor [1.0d0].
801     !  </description>
802           MAX_INLET_VEL_FAC = ONE
803     !</keyword>
804     
805     !<keyword category="Numerical Parameters" required="false">
806     !  <description>
807     !    Solve transpose of linear system. (BICGSTAB ONLY).
808     !  </description>
809     !  <dependent keyword="LEQ_METHOD" value="2"/>
810           DO_TRANSPOSE = .FALSE.
811     !</keyword>
812     
813     !<keyword category="Numerical Parameters" required="false">
814     !  <description>
815     !    Frequency to check for convergence. (BICGSTAB ONLY)
816     !  </description>
817     !  <dependent keyword="LEQ_METHOD" value="2"/>
818           icheck_bicgs = 1
819     !</keyword>
820     
821     !<keyword category="Numerical Parameters" required="false">
822     !  <description>
823     !    Sets optimal LEQ flags for parallel runs.
824     !  </description>
825           OPT_PARALLEL = .FALSE.
826     !</keyword>
827     
828     !<keyword category="Numerical Parameters" required="false">
829     !  <description>
830     !    Use do-loop assignment over direct vector assignment.
831     !  </description>
832           USE_DOLOOP = .FALSE.
833     !</keyword>
834     
835     !<keyword category="Numerical Parameters" required="false">
836     !  <description>
837     !    Calculate dot-products more efficiently (Serial runs only.)
838     !  </description>
839           IS_SERIAL = .TRUE.
840     !</keyword>
841     
842     
843     !#####################################################################!
844     !                      Geometry and Discretization                    !
845     !#####################################################################!
846     
847     
848     !<keyword category="Geometry and Discretization" required="false">
849     !  <description>Coordinates used in the simulation.</description>
850     !  <valid value="cartesian" note="Cartesian coordinates."/>
851     !  <valid value="cylindrical" note="Cylindrical coordinates."/>
852           COORDINATES = UNDEFINED_C
853     !</keyword>
854     
855     !<keyword category="Geometry and Discretization" required="false">
856     !  <description>(Do not use.)</description>
857     !  <valid value=".FALSE." note="x (r) direction is considered."/>
858     !  <valid value=".TRUE." note="x (r) direction is not considered."/>
859     !     NO_I = .FALSE.
860     !</keyword>
861     
862     !<keyword category="Geometry and Discretization" required="false">
863     !  <description>Number of cells in the x (r) direction.</description>
864           IMAX = UNDEFINED_I
865     !</keyword>
866     
867     !<keyword category="Geometry and Discretization" required="false">
868     !  <description>
869     !    Cell sizes in the x (r) direction. Enter values from DX(0) to
870     !    DX(IMAX-1).
871     !    o Use uniform mesh size with higher-order discretization methods.
872     !    o DX should be kept uniform in cylindrical coordinates
873     !      for strict momentum conservation.
874     !  </description>
875     !  <arg index="1" id="Cell" min="0" max="DIM_I"/>
876           DX(:DIM_I) = UNDEFINED
877     !</keyword>
878     
879     !<keyword category="Geometry and Discretization" required="false">
880     !  <description>
881     !    The inner radius in the simulation of an annular cylindrical region.
882     !  </description>
883           XMIN = ZERO
884     !</keyword>
885     
886     !<keyword category="Geometry and Discretization" required="false">
887     !  <description>Reactor length in the x (r) direction.</description>
888           XLENGTH = UNDEFINED
889     !</keyword>
890     
891     !<keyword category="Geometry and Discretization" required="false">
892     !  <description>(Do not use.)</description>
893     !  <valid value=".FALSE. note="y-direction is considered."/>
894     !  <valid value=".TRUE." note="y-direction is not considered."/>
895     !     NO_J = .FALSE.
896     !</keyword>
897     
898     
899     !<keyword category="Geometry and Discretization" required="false">
900     !  <description>Number of cells in the y-direction.</description>
901           JMAX = UNDEFINED_I
902     !</keyword>
903     
904     !<keyword category="Geometry and Discretization" required="false">
905     !  <description>
906     !    Cell sizes in the y-direction. Enter values from DY(0) to
907     !    DY(IMAX-1). Use uniform mesh size with second-order
908     !    discretization methods.
909     !  </description>
910     !  <arg index="1" id="Cell" min="0" max="DIM_J"/>
911           DY(:DIM_J) = UNDEFINED
912     !</keyword>
913     
914     !<keyword category="Geometry and Discretization" required="false">
915     !  <description>Reactor length in the y-direction.</description>
916           YLENGTH = UNDEFINED
917     !</keyword>
918     
919     !<keyword category="Geometry and Discretization" required="false">
920     !  <description>
921     !    Flag to disable the third dimension (i.e., 2D simulation).
922     !      o Z axis in Cartesian coordinate system
923     !      o Theta in Cylindrical coordinate system
924     !  </description>
925     !  <valid value=".FALSE." note="3D simulation."/>
926     !  <valid value=".TRUE."  note="2D simulation."/>
927           NO_K = .FALSE.
928     !</keyword>
929     
930     !<keyword category="Geometry and Discretization" required="false">
931     !  <description>Number of cells in the z-direction.</description>
932           KMAX = UNDEFINED_I
933     !</keyword>
934     
935     !<keyword category="Geometry and Discretization" required="false">
936     !  <description>
937     !    Cell sizes in the z (theta) direction. Enter values from DZ(0) to
938     !    DZ(IMAX-1). Use uniform mesh size with second-order discretization
939     !    methods.
940     !  </description>
941     !  <arg index="1" id="Cell" min="0" max="DIM_K"/>
942           DZ(:DIM_K) = UNDEFINED
943     !</keyword>
944     
945     !<keyword category="Geometry and Discretization" required="false">
946     !  <description>Reactor length in the z (theta) direction.</description>
947           ZLENGTH = UNDEFINED
948     !</keyword>
949     
950     
951     !<keyword category="Geometry and Discretization" required="false">
952     !  <description>
953     !    Flag for making the x-direction cyclic without pressure drop. No other
954     !    boundary conditions for the x-direction should be specified.
955     !</description>
956     !  <valid value=".FALSE." note="No cyclic condition at x-boundary."/>
957     !  <valid value=".TRUE." note="Cyclic condition at x-boundary."/>
958           CYCLIC_X = .FALSE.
959     !</keyword>
960     
961     !<keyword category="Geometry and Discretization" required="false">
962     !  <description>
963     !    Flag for making the x-direction cyclic with pressure drop. If the
964     !    keyword FLUX_G is given a value this becomes a cyclic boundary
965     !    condition with specified mass flux. No other boundary conditions
966     !    for the x-direction should be specified.
967     !  </description>
968     !  <valid value=".FALSE." note="No cyclic condition at x-boundary."/>
969     !  <valid value=".TRUE." note="Cyclic condition with pressure drop at x-boundary."/>
970           CYCLIC_X_PD = .FALSE.
971     !</keyword>
972     
973     !<keyword category="Geometry and Discretization" required="false">
974     !  <description>
975     !    Fluid pressure drop across XLENGTH when a cyclic boundary condition
976     !    with pressure drop is imposed in the x-direction.
977     !  </description>
978           DELP_X = UNDEFINED
979     !</keyword>
980     
981     !<keyword category="Geometry and Discretization" required="false">
982     !  <description>
983     !    Flag for making the y-direction cyclic without pressure drop. No
984     !    other boundary conditions for the y-direction should be specified.
985     !  </description>
986     !  <valid value=".FALSE." note="No cyclic condition at y-boundary."/>
987     !  <valid value=".TRUE." note="Cyclic condition at x-boundary."/>
988           CYCLIC_Y = .FALSE.
989     !</keyword>
990     
991     !<keyword category="Geometry and Discretization" required="false">
992     !  <description>
993     !    Flag for making the y-direction cyclic with pressure drop. If the
994     !    keyword FLUX_G is given a value this becomes a cyclic boundary
995     !    condition with specified mass flux. No other boundary conditions
996     !    for the y-direction should be specified.
997     !  </description>
998     !  <valid value=".FALSE." note="No cyclic condition at y-boundary."/>
999     !  <valid value=".TRUE." note="Cyclic condition with pressure drop at y-boundary."/>
1000           CYCLIC_Y_PD = .FALSE.
1001     !</keyword>
1002     
1003     !<keyword category="Geometry and Discretization" required="false">
1004     !  <description>
1005     !    Fluid pressure drop across YLENGTH when a cyclic boundary condition
1006     !    with pressure drop is imposed in the y-direction.
1007     !  </description>
1008           DELP_Y = UNDEFINED
1009     !</keyword>
1010     
1011     !<keyword category="Geometry and Discretization" required="false">
1012     !  <description>
1013     !    Flag for making the z-direction cyclic without pressure drop. No
1014     !    other boundary conditions for the z-direction should be specified.
1015     !  </description>
1016     !  <valid value=".FALSE." note="No cyclic condition at z-boundary."/>
1017     !  <valid value=".TRUE." note="Cyclic condition at z-boundary."/>
1018           CYCLIC_Z = .FALSE.
1019     !</keyword>
1020     
1021     !<keyword category="Geometry and Discretization" required="false">
1022     !  <description>
1023     !    Flag for making the z-direction cyclic with pressure drop. If the
1024     !    keyword FLUX_G is given a value this becomes a cyclic boundary
1025     !    condition with specified mass flux. No other boundary conditions
1026     !    for the z-direction should be specified.
1027     !  </description>
1028     !  <valid value=".FALSE." note="No cyclic condition at z-boundary."/>
1029     !  <valid value=".TRUE." note="Cyclic condition with pressure drop at
1030     !    z-boundary."/>
1031           CYCLIC_Z_PD = .FALSE.
1032     !</keyword>
1033     
1034     !<keyword category="Geometry and Discretization" required="false">
1035     !  <description>
1036     !    Fluid pressure drop across ZLENGTH when a cyclic boundary condition
1037     !    with pressure drop is imposed in the z-direction.
1038     !  </description>
1039           DELP_Z = UNDEFINED
1040     !</keyword>
1041     
1042     !<keyword category="Geometry and Discretization" required="false">
1043     !  <description>
1044     !    Imposes a mean shear on the flow field as a linear function of the
1045     !    x coordinate. This feature should only be used when CYCLIC_X is
1046     !    .TRUE. and the keyword V_SH is set.
1047     !  </description>
1048     !  <dependent keyword="CYCLIC_X" value=".TRUE."/>
1049     !  <dependent keyword="V_SH" value="DEFINED"/>
1050           SHEAR = .FALSE.
1051     !</keyword>
1052     
1053     
1054     !<keyword category="Geometry and Discretization" required="false">
1055     !  <description>
1056     !    Specifies the mean y velocity component at the eastern boundary
1057     !    of the domain (V_SH), and the mean Y velocity (-V_SH) at the
1058     !    western boundary of the domain.
1059     !  </description>
1060           V_sh = 0.0d0
1061     !</keyword>
1062     
1063     
1064     !<keyword category="Geometry and Discretization" required="false">
1065     !  <description>
1066     !    If a value is specified (in units of g/cm^2.s), the domain-averaged gas
1067     !    flux is held constant at that value in simulations over a periodic
1068     !    domain.  A pair of boundaries specified as periodic with fixed
1069     !    pressure drop is then treated as periodic with fixed mass flux.
1070     !    Even for this case a pressure drop must also be specified, which
1071     !    is used as the initial guess in the simulations.
1072     !  </description>
1073           Flux_g = UNDEFINED
1074     !</keyword>
1075     
1076     !<keyword category="Geometry and Discretization" required="false">
1077     !  <description>
1078     !    Applies the 2.5D model for cylindrical column by combining 2D assumption
1079     !    and axi-symmetric assumption.
1080     !    Li et al. (2015). A 2.5D computational method to simulate
1081     !    cylindrical fluidized beds, Chemical Engineering Science,
1082     !    123:236-246.
1083     !  </description>
1084           CYLINDRICAL_2D = .FALSE.
1085     !</keyword>
1086     
1087     !<keyword category="Geometry and Discretization" required="false">
1088     !  <description>
1089     !    Parameter to control the plate half width and the wedge radius
1090     !    in the 2.5D cylindrical model. This value should be less than
1091     !    half the grid cells in the radial direction (IMAX/2).  [1]
1092     !  </description>
1093     !  <dependent keyword="CYLINDRICAL_2D" value=".TRUE."/>
1094           I_CYL_NUM = 1
1095     !</keyword>
1096     
1097     !<keyword category="Geometry and Discretization" required="false">
1098     !  <description>
1099     !    Parameter to smooth the transition from cylindrical to 2D in
1100     !    the 2.5D cylindrical model. [2]
1101     !  </description>
1102     !  <valid value="2" note="Two cell smoothing transition."/>
1103     !  <valid value="1" note="One cell smoothing transition."/>
1104     !  <valid value="0" note="No smoothing."/>
1105     !  <dependent keyword="CYLINDRICAL_2D" value=".TRUE."/>
1106           I_CYL_TRANSITION = 2
1107     !</keyword>
1108     
1109     !#####################################################################!
1110     !                               Gas Phase                             !
1111     !#####################################################################!
1112     
1113     !<keyword category="Gas Phase" required="false">
1114     !  <description>
1115     !    Specified constant gas density [g/cm^3 in CGS]. An equation of
1116     !    state -the ideal gas law by default- is used to calculate the gas
1117     !    density if this parameter is undefined. The value may be set to
1118     !    zero to make the drag zero and to simulate granular flow in a
1119     !    vacuum. For this case, users may turn off solving for gas momentum
1120     !    equations to accelerate convergence.
1121     !  </description>
1122           RO_G0 = UNDEFINED
1123     !</keyword>
1124     
1125     !<keyword category="Gas Phase" required="false">
1126     !  <description>
1127     !    Specified constant gas viscosity [g/(cm.s) in CGS].
1128     !  </description>
1129           MU_G0 = UNDEFINED
1130     !</keyword>
1131     
1132     !<keyword category="Gas Phase" required="false">
1133     !  <description>
1134     !    Specified constant gas conductivity [cal/(s.cm.K) in CGS].
1135     !  </description>
1136           K_G0 = UNDEFINED
1137     !</keyword>
1138     
1139     !<keyword category="Gas Phase" required="false">
1140     !  <description>
1141     !    Specified constant gas specific heat [cal/(g.s.K) in CGS].
1142     !  </description>
1143           C_PG0 = UNDEFINED
1144     !</keyword>
1145     
1146     !<keyword category="Gas Phase" required="false">
1147     !  <description>
1148     !    Specified constant gas diffusivity [(cm^2/s) in CGS].
1149     !  </description>
1150           DIF_G0 = UNDEFINED
1151     !</keyword>
1152     
1153     !<keyword category="Gas Phase" required="false">
1154     !  <description>
1155     !    Average molecular weight of gas [(g/mol) in CGS]. Used in
1156     !    calculating the gas density for non-reacting flows when the gas
1157     !    composition is not defined.
1158     !  </description>
1159           MW_AVG = UNDEFINED
1160     !</keyword>
1161     
1162     !<keyword category="Gas Phase" required="false">
1163     !  <description>
1164     !    Molecular weight of gas species [(g/mol) in GCS].
1165     !  </description>
1166     !  <arg index="1" id="Species" min="1" max="DIM_N_G"/>
1167           MW_G(:DIM_N_G) = UNDEFINED
1168     !</keyword>
1169     
1170     !<keyword category="Gas Phase" required="false">
1171     !  <description>Number of species comprising the gas phase.</description>
1172           NMAX_g = UNDEFINED_I
1173     !</keyword>
1174     
1175     !<keyword category="Gas Phase" required="false">
1176     !  <description>
1177     !    Name of gas phase species as it appears in the materials database.
1178     !  </description>
1179     !  <arg index="1" id="Species" min="1" max="DIM_N_G"/>
1180           SPECIES_g = UNDEFINED_C
1181     !</keyword>
1182     
1183     !<keyword category="Gas Phase" required="false">
1184     !  <description>
1185     !    User defined name for gas phase species. Aliases are used in
1186     !    specifying chemical equations and must be unique.
1187     !  </description>
1188     !  <arg index="1" id="Species" min="1" max="DIM_N_G"/>
1189           SPECIES_ALIAS_g = UNDEFINED_C
1190     !</keyword>
1191     
1192     
1193     
1194     !#####################################################################!
1195     !                            Solids Phase                             !
1196     !#####################################################################!
1197     
1198     !<keyword category="Solids Phase" required="false">
1199     !  <description>
1200     !    Defines the model used for the solids phase. For TFM/DEM
1201     !    hybrid simulations, first define all TFM solids, then
1202     !    define the DEM solids phases.
1203     !  </description>
1204     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1205     !  <valid value='TFM' note='Two-fluid Model (continuum)' />
1206     !  <valid value='DEM' note='Discrete Element Model' />
1207     !  <valid value='PIC' note='Multiphase-Particle in Cell' />
1208           SOLIDS_MODEL(:DIM_M) = 'TFM'
1209     !</keyword>
1210     
1211     !<keyword category="Solids Phase" required="false"
1212     !  tfm="true" dem="true" pic="true">
1213     !  <description>Number of solids phases.</description>
1214           MMAX = 1
1215     !</keyword>
1216     
1217     !<keyword category="Solids Phase" required="false"
1218     !  tfm="true" dem="true" pic="true">
1219     !  <description>
1220     !    Initial particle diameters [cm in CGS].
1221     !  </description>
1222     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1223           D_P0(:DIM_M) = UNDEFINED
1224     !</keyword>
1225     
1226     !<keyword category="Solids Phase" required="false"
1227     !  tfm="true" dem="true" pic="true">
1228     !  <description>
1229     !    Specified constant solids density [g/cm^3 in CGS]. Reacting flows
1230     !    may use variable solids density by leaving this parameter
1231     !    undefined and specifying X_S0 and RO_XS0 as well as the index
1232     !    of the inert species.
1233     !  </description>
1234     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1235           RO_S0(:DIM_M) = UNDEFINED
1236     !</keyword>
1237     
1238     !<keyword category="Solids Phase" required="false" tfm="true" dem="true">
1239     !  <description>
1240     !    Baseline species mass fraction. Specifically, the mass fraction
1241     !    of an unreacted sample (e.g., proximate analysis).
1242     !  </description>
1243     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1244     !  <arg index="2" id="Species" min="1" max="DIM_N_s"/>
1245     !  <dependent keyword="SPECIES_EQ" value=".TRUE."/>
1246     !  <dependent keyword="RO_Xs0" value="DEFINED"/>
1247     !  <dependent keyword="INERT_SPECIES" value="DEFINED"/>
1248     !  <conflict keyword="RO_s0" value="DEFINED"/>
1249           X_s0(:DIM_M,:DIM_N_s) = UNDEFINED
1250     !</keyword>
1251     
1252     !<keyword category="Solids Phase" required="false" tfm="true" dem="true">
1253     !  <description>
1254     !    Specified constant solids species density [g/cm^3 in CGS].
1255     !  </description>
1256     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1257     !  <arg index="2" id="Species" min="1" max="DIM_N_s"/>
1258     !  <dependent keyword="SPECIES_EQ" value=".TRUE."/>
1259     !  <dependent keyword="X_s0" value="DEFINED"/>
1260     !  <dependent keyword="INERT_SPECIES" value="DEFINED"/>
1261     !  <conflict keyword="RO_s0" value="DEFINED"/>
1262           RO_Xs0(:DIM_M,:DIM_N_s) = UNDEFINED
1263     !</keyword>
1264     
1265     !<keyword category="Solids Phase" required="false" tfm="true" dem="true">
1266     !  <description>
1267     !    Index of inert solids phase species. This species should not be a
1268     !    product or reactant of any chemical reaction.
1269     !  </description>
1270     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1271     !  <arg index="2" id="Species" min="1" max="DIM_N_s"/>
1272     !  <dependent keyword="SPECIES_EQ" value=".TRUE."/>
1273     !  <dependent keyword="X_s0" value="DEFINED"/>
1274     !  <dependent keyword="RO_Xs0" value="DEFINED"/>
1275     !  <conflict keyword="RO_s0" value="DEFINED"/>
1276           INERT_SPECIES(:DIM_M) = UNDEFINED_I
1277     !</keyword>
1278     
1279     !<keyword category="Solids Phase" required="false" tfm="true" dem="true">
1280     !  <description>
1281     !    Mass fraction of inert solids phase species in the dilute region.
1282     !    In dilute region (see DIL_FACTOR_VSD), the solids density is computed based 
1283     !    on this inert species mass fraction, rather than the current inert species mass fraction.
1284     !    This may help convergence when the Variable Solids Density model is invoked.
1285     !  </description>
1286     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1287     !  <dependent keyword="SPECIES_EQ" value=".TRUE."/>
1288     !  <dependent keyword="X_s0" value="DEFINED"/>
1289     !  <dependent keyword="RO_Xs0" value="DEFINED"/>
1290     !  <conflict keyword="RO_s0" value="DEFINED"/>
1291           DIL_INERT_X_VSD(:DIM_M) = ONE
1292     !</keyword>
1293     
1294     !<keyword category="Solids Phase" required="false" tfm="true" dem="true">
1295     !  <description>
1296     !    Factor to define the dilute region where the solids density is set using DIL_INERT_X_VSD.
1297     !    Cells where the solids volume fraction is between DIL_EP_S and DIL_EP_S x DIL_FACTOR_VSD
1298     !    will automatically set the solids density using DIL_INERT_X_VSD instead of the current 
1299     !    inerts species mass fraction. Set this factor to zero to always use the current inert
1300     !    species mass fraction.
1301     !  </description>
1302     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1303     !  <dependent keyword="SPECIES_EQ" value=".TRUE."/>
1304     !  <dependent keyword="X_s0" value="DEFINED"/>
1305     !  <dependent keyword="RO_Xs0" value="DEFINED"/>
1306     !  <conflict keyword="RO_s0" value="DEFINED"/>
1307           DIL_FACTOR_VSD = 10.0D0
1308     !</keyword>
1309     
1310     !<keyword category="Solids Phase" required="false" tfm="true" dem="true">
1311     !  <description>
1312     !    Specified constant solids conductivity [cal/(s.cm.K) in CGS].
1313     !  </description>
1314     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1315           K_S0(:DIM_M) = UNDEFINED
1316     !</keyword>
1317     
1318     !<keyword category="Solids Phase" required="false" tfm="true" dem="true">
1319     !  <description>
1320     !    Specified constant solids specific heat [cal/(g.s.K) in CGS].
1321     !  </description>
1322     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1323           C_PS0(:DIM_M) = UNDEFINED
1324     !</keyword>
1325     
1326     
1327     !<keyword category="Solids Phase" required="false" tfm="true" dem="true">
1328     !  <description>
1329     !    Molecular weight of solids phase species [(g/mol) in CGS].
1330     !  </description>
1331     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1332     !  <arg index="2" id="Species" min="1" max="DIM_N_s"/>
1333           MW_S(:DIM_M,:DIM_N_s) = UNDEFINED
1334     !</keyword>
1335     
1336     !<keyword category="Solids Phase" required="false" tfm="true" dem="true">
1337     !  <description>
1338     !    Number of species comprising the solids phase.
1339     !  </description>
1340     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1341           NMAX_s(:DIM_M) = UNDEFINED_I
1342     !</keyword>
1343     
1344     !<keyword category="Solids Phase" required="false" tfm="true" dem="true">
1345     !  <description>
1346     !    Name of solids phase M, species N as it appears in the materials
1347     !    database.
1348     !</description>
1349     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1350     !  <arg index="2" id="Species" min="1" max="DIM_N_s"/>
1351           SPECIES_s(:DIM_M,:DIM_N_s) = UNDEFINED_C
1352     !</keyword>
1353     
1354     !<keyword category="Solids Phase" required="false" tfm="true" dem="true">
1355     !  <description>
1356     !    User defined name for solids phase species. Aliases are used in
1357     !    specifying chemical equations and must be unique.
1358     !  </description>
1359     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1360     !  <arg index="2" id="Species" min="1" max="DIM_N_s"/>
1361           SPECIES_ALIAS_s(:DIM_M,:DIM_N_s) = UNDEFINED_C
1362     !</keyword>
1363     
1364     !#####################################################################!
1365     !                           Two Fluid Model                           !
1366     !#####################################################################!
1367     
1368     
1369     !<keyword category="Two Fluid Model" required="false" tfm="true">
1370     !  <description>
1371     !    Solids phase stress model [LUN_1984]. This is only needed when
1372     !    solving the granular energy PDE (GRANULAR_ENERGY = .TRUE.).
1373     !  </description>
1374     !  <dependent keyword="GRANULAR_ENERGY" value=".TRUE."/>
1375     !  <valid value="AHMADI"
1376     !    note="Cao and Ahmadi (1995). Int. J. Multiphase Flow 21(6), 1203."/>
1377     !  <valid value="GD_99"
1378     !     note="Garzo and Dufty (1999). Phys. Rev. E 59(5), 5895."/>
1379     !  <valid value="GHD"
1380     !    note="Garzo, Hrenya and Dufty (2007). Phys. Rev. E 76(3), 31304"/>
1381     !  <valid value="GTSH"
1382     !    note="Garzo, Tenneti, Subramaniam, Hrenya (2012). J.Fluid Mech. 712, 129."/>
1383     !  <valid value="IA_NONEP"
1384     !     note="Iddir & Arastoopour (2005). AIChE J. 51(6), 1620"/>
1385     !  <valid value="LUN_1984"
1386     !    note="Lun et al (1984). J. Fluid Mech., 140, 223."/>
1387     !  <valid value="SIMONIN"
1388     !    note="Simonin (1996). VKI Lecture Series, 1996-2"/>
1389           KT_TYPE = "LUN_1984"
1390     !</keyword>
1391     
1392     ! Retired keyword for specifying Ahmadi KT Theory.
1393     ! Use: KT_TYPE = "AHMADI"
1394           AHMADI = .FALSE.
1395     
1396     ! Retired keyword for specifying Simonin KT Theory.
1397     ! Use: KT_TYPE = "SIMONIN"
1398           SIMONIN = .FALSE.
1399     
1400     !<keyword category="Two Fluid Model" required="false" tfm="true">
1401     !  <description>
1402     !    Solids stress model selection.
1403     !  </description>
1404     !  <valid value=".FALSE." note="Do not use the Princeton solids stress model."/>
1405     !  <valid value=".TRUE."  note="Use the Princeton solids stress model"/>
1406     !  <dependent keyword="GRANULAR_ENERGY" value=".TRUE."/>
1407     !  <dependent keyword="PHI" value="DEFINED"/>
1408     !  <dependent keyword="PHI_W" value="DEFINED"/>
1409           FRICTION = .FALSE.
1410     !</keyword>
1411     
1412     !<keyword category="Two Fluid Model" required="false" tfm="true">
1413     !  <description>
1414     !    For a term appearing in the frictional stress model
1415     !    invoked with FRICTION keyword.
1416     !  </description>
1417     !  <valid value="0" note="Use S:S in the frictional stress model."/>
1418     !  <valid value="1" note="Use an alternate form suggested by Savage."/>
1419     !  <valid value="2" note="An appropriate combination of above."/>
1420     !  <dependent keyword="friction" value=".TRUE."/>
1421           SAVAGE = 1
1422     !</keyword>
1423     
1424     !<keyword category="Two Fluid Model" required="false" tfm="true">
1425     !  <description>
1426     !    Schaeffer frictional stress tensor formulation. </description>
1427     !  <dependent keyword="PHI" value="DEFINED"/>
1428     !  <valid value=".TRUE." note="Use the Schaeffer model."/>
1429     !  <valid value=".FALSE." note="Do not use the Schaeffer model."/>
1430           SCHAEFFER = .TRUE.
1431     !</keyword>
1432     
1433     !<keyword category="Two Fluid Model" required="false" tfm="true">
1434     !  <description>
1435     !    Blend the Schaeffer stresses with the stresses resulting from
1436     !    algebraic kinetic theory around the value of EP_STAR.
1437     !  </description>
1438           BLENDING_STRESS = .FALSE.
1439     !</keyword>
1440     
1441     !<keyword category="Two Fluid Model" required="false" tfm="ture">
1442     !  <description>
1443     !    Hyperbolic tangent function for blending frictional stress models.
1444     !  </description>
1445     !  <dependent keyword="BLENDING_STRESS" value=".TRUE."/>
1446     !  <conflict keyword="SIGM_BLEND" value=".TRUE."/>
1447           TANH_BLEND = .TRUE.
1448     !</keyword>
1449     
1450     !<keyword category="Two Fluid Model" required="false" tfm="true">
1451     !  <description>
1452     !    A scaled and truncated sigmoidal function for blending
1453     !    frictional stress models.
1454     !  </description>
1455     !  <dependent keyword="BLENDING_STRESS" value=".TRUE."/>
1456     !  <conflict keyword="TANH_BLEND" value=".TRUE."/>
1457           SIGM_BLEND = .FALSE.
1458     !</keyword>
1459     
1460     !<keyword category="Two Fluid Model" required="false" tfm="true">
1461     !  <description>
1462     !    Correlation to compute maximum packing for polydisperse systems.
1463     !  </description>
1464     !  <valid value=".TRUE."
1465     !    note="Use the Yu and Standish correlation."/>
1466     !  <valid value=".FALSE."
1467     !    note="Do not use the Yu and Standish correlation."/>
1468           YU_STANDISH = .FALSE.
1469     !</keyword>
1470     
1471     !<keyword category="Two Fluid Model" required="false" tfm="true">
1472     !  <description>
1473     !    Correlation to compute maximum packing for binary (only)
1474     !    mixtures of powders.
1475     !  </description>
1476     !  <valid value=".TRUE."
1477     !    note="Use the Fedors and Landel correlation."/>
1478     !  <valid value=".FALSE."
1479     !    note="Do not use the Fedors and Landel correlation."/>
1480           FEDORS_LANDEL = .FALSE.
1481     !</keyword>
1482     
1483     !<keyword category="Two Fluid Model" required="false" tfm="true">
1484     !  <description>
1485     !    Radial distribution function at contact for polydisperse systems.
1486     !    Do not specify any RDF for monodisperse systems because Carnahan-
1487     !    Starling is the model only available.
1488     !
1489     !    Carnahan, N.F. and Starling K.E., (1969).
1490     !    The Journal of Chemical Physics, Vol. 51(2):635-636.
1491     !  </description>
1492     !
1493     !  <valid value="LEBOWITZ" note="Lebowitz, J.L. (1964)
1494     !   The Physical Review, A133, 895-899"/>
1495     !
1496     !  <valid value="MODIFIED_LEBOWITZ" note="
1497     !    Iddir, H. Y., Modeling of the multiphase mixture of particles
1498     !    using the kinetic theory approach. Doctoral Dissertation,
1499     !    Illinois Institute of Technology, Chicago, Illinois, 2004,
1500     !    (chapter 2, equations 2-49 through 2-52.)"/>
1501     !
1502     !  <valid value="MANSOORI" note="
1503     !   Mansoori, GA, Carnahan N.F., Starling, K.E. Leland, T.W. (1971).
1504     !    The Journal of Chemical Physics, Vol. 54:1523-1525."/>
1505     !
1506     !  <valid value="MODIFIED_MANSOORI" note="van Wachem, B.G.M., Schouten, J.C.,
1507     !    van den Bleek, C.M., Krishna, R. and Sinclair, J. L. (2001)
1508     !    AIChE Journal 47:1035–1051."/>
1509           RDF_TYPE = 'LEBOWITZ'
1510     !</keyword>
1511     
1512     !<keyword category="Two Fluid Model" required="false" tfm="true">
1513     !  <description>
1514     !    Flag to include the added (or virtual) mass force. This force
1515     !    acts to increase the inertia of the dispersed phase, which
1516     !    tends to stabilize simulations of bubbly gas-liquid flows.
1517     !  </description>
1518     !  <dependent keyword="M_AM" value="DEFINED"/>
1519           Added_Mass = .FALSE.
1520     !</keyword>
1521     
1522     !<keyword category="Two Fluid Model" required="false" tfm="true">
1523     !  <description>
1524     !    The disperse phase number to which the added mass is applied.
1525     !  </description>
1526           M_AM = UNDEFINED_I
1527     !</keyword>
1528     
1529     !<keyword category="Two Fluid Model" required="false" tfm="true">
1530     !  <description>
1531     !    Coefficient of restitution for particle-particle collisions.
1532     !  </description>
1533     !  <range min="0.0" max="1.0" />
1534           C_E = UNDEFINED
1535     !</keyword>
1536     
1537     !<keyword category="Two Fluid Model" required="false">
1538     !  <description>
1539     !    Coefficient of restitution for particle-particle collisions specific
1540     !    to GHD theory implementation.
1541     !  </description>
1542     !  <arg index="1" id="Phase" min="0" max="DIM_M"/>
1543     !  <arg index="2" id="Phase" min="0" max="DIM_M"/>
1544           r_p(:DIM_M, :DIM_M) = UNDEFINED
1545     !</keyword>
1546     
1547     !<keyword category="Two Fluid Model" required="false">
1548     !  <description>
1549     !    Coefficient of restitution for particle-wall collisions when using
1550     !    Johnson and Jackson partial slip BC (BC_JJ_PS).</description>
1551     !  <range min="0.0" max="1.0" />
1552           E_W = 1.D0
1553     !</keyword>
1554     
1555     !<keyword category="Two Fluid Model" required="false" tfm="true">
1556     !  <description>
1557     !    Specularity coefficient associated with particle-wall collisions
1558     !    when using Johnson and Jackson partial slip BC (BC_JJ_PS). If
1559     !    Jenkins small frictional BC are invoked (JENKINS) then phip is
1560     !    not used.
1561     !  </description>
1562     !  <range min="0.0" max="1.0" />
1563           PHIP = 0.6D0
1564     !</keyword>
1565     
1566     !<keyword category="Two Fluid Model" required="false" tfm="true">
1567     !  <description>
1568     !    Specify the value of specularity coefficient when the normalized
1569     !    slip velocity goes to zero when BC_JJ_M is .TRUE.. This variable
1570     !    is calculated internally in the code. Do not modify unless an
1571     !    accurate number is known.
1572     !  </description>
1573     !  <dependent keyword="BC_JJ_M" value=".TRUE."/>
1574           phip0 = undefined
1575     !</keyword>
1576     
1577     !<keyword category="Two Fluid Model" required="false" tfm="true">
1578     !  <description>
1579     !    Coefficient of friction between the particles of two solids phases.
1580     !  </description>
1581           C_F = UNDEFINED
1582     !</keyword>
1583     
1584     !<keyword category="Two Fluid Model" required="false" tfm="true">
1585     !  <description>
1586     !     Angle of internal friction (in degrees). Set this value
1587     !     to zero to turn off plastic regime stress calculations.
1588     !  </description>
1589           PHI = UNDEFINED
1590     !</keyword>
1591     
1592     !<keyword category="Two Fluid Model" required="false" tfm="true">
1593     !  <description>
1594     !    Angle of internal friction (in degrees) at walls. Set this
1595     !    value to non-zero (PHI_W = 11.31 means TAN_PHI_W = MU = 0.2)
1596     !    when using Johnson and Jackson partial slip BC (BC_JJ_PS) with
1597     !    Friction model or Jenkins small frictional boundary condition.
1598     !  </description>
1599           PHI_W = UNDEFINED
1600     !</keyword>
1601     
1602     !<keyword category="Two Fluid Model" required="false" tfm="true">
1603     !  <description>
1604     !    Minimum solids fraction above which friction sets in. [0.5] (when
1605     !    FRICTION = .TRUE.)
1606     !  </description>
1607     !  <dependent keyword="FRICTION" value=".TRUE."/>
1608           EPS_F_MIN = 0.5D0
1609     !</keyword>
1610     
1611     !<keyword category="Two Fluid Model" required="false" tfm="true">
1612     !  <description>
1613     !    Maximum solids volume fraction at packing for polydisperse
1614     !    systems (more than one solids phase used). The value of
1615     !    EP_STAR may change during the computation if solids phases
1616     !    with different particle diameters are specified and
1617     !    Yu_Standish or Fedors_Landel correlations are used.
1618     !  </description>
1619     !  <arg index="1" id="Phase" min="0" max="DIM_M"/>
1620     !  <range min="0" max="1-EP_STAR" />
1621           EP_S_MAX(:DIM_M) = UNDEFINED
1622     !</keyword>
1623     
1624     !<keyword category="Two Fluid Model" required="false" tfm="true">
1625     !  <description>
1626     !    Used in calculating the initial slope of segregation: see
1627     !    Gera et al. (2004) - recommended value 0.3. Increasing this
1628     !    coefficient results in decrease in segregation of particles
1629     !    in binary mixtures.
1630     !  </description>
1631           SEGREGATION_SLOPE_COEFFICIENT=0.D0
1632     !</keyword>
1633     
1634     
1635     !<keyword category="Two Fluid Model" required="false" tfm="true">
1636     !  <description>Excluded volume in Boyle-Massoudi stress.</description>
1637     !  <valid value="0.0" note="b-m stress is turned off."/>
1638           V_EX = ZERO
1639     !</keyword>
1640     
1641     !<keyword category="Two Fluid Model" required="false" tfm="true">
1642     !  <description>
1643     !    Specified constant viscosity. If any value is specified then:
1644     !    1) kinetic theory calculations (granular_energy) are off, which
1645     !       means zero granular pressure contribution (P_S = 0),
1646     !    2) frictional/plastic calculations are off, which means zero
1647     !       frictional viscosity contributions, however, a plastic pressure
1648     !       term is still invoked (P_STAR), and
1649     !    3) LAMBDA_S = -2/3 MU_S0.
1650     !  </description>
1651     !  <conflict keyword="GRANULAR_ENERGY" value=".TRUE."/>
1652     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1653           MU_S0(:DIM_M) = UNDEFINED
1654     !</keyword>
1655     
1656     !<keyword category="Two Fluid Model" required="false" tfm="true">
1657     !  <description>
1658     !    Specified constant solids diffusivity [(cm^2)/s in CGS].
1659     !  </description>
1660           DIF_S0 = UNDEFINED
1661     !</keyword>
1662     
1663     !<keyword category="Two Fluid Model" required="false" tfm="true">
1664     !  <description>
1665     !    Packed bed void fraction. Used to calculate plastic stresses (for
1666     !    contribution to viscosity) and when to implement plastic pressure,
1667     !    P_STAR. Specifically, if EP_G < EP_STAR, then plastic pressure is
1668     !    employed in the momentum equations.
1669     !  </description>
1670     !  <range min="0.0" max="1.0" />
1671           EP_STAR = UNDEFINED
1672     !</keyword>
1673     
1674     !<keyword category="Two Fluid Model" required="false" tfm="true">
1675     !  <description>
1676     !    Flag to enable/disable a phase from forming a packed bed.
1677     !    Effectively removes plastic pressure term from the solids phase
1678     !    momentum equation.
1679     !  </description>
1680     !  <arg index="1" id="Phase" min="1" max="DIM_M"/>
1681     !  <valid value=".TRUE." note="The phase forms a packed bed with void
1682     !    fraction EP_STAR."/>
1683     !  <valid value=".FALSE." note="The phase can exceed close pack conditions
1684     !    so that it maybe behave like a liquid."/>
1685           CLOSE_PACKED(:DIM_M) = .TRUE.
1686     !</keyword>
1687     
1688     
1689     !#####################################################################!
1690     !                   Initial Conditions Section                        !
1691     !#####################################################################!
1692     
1693     
1694           DO LC = 1, DIMENSION_IC
1695     
1696     !<keyword category="Initial Condition" required="false">
1697     !  <description>X coordinate of the west face.</description>
1698     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1699              IC_X_W(LC) = UNDEFINED
1700     !</keyword>
1701     
1702     !<keyword category="Initial Condition" required="false">
1703     !  <description>X coordinate of the east face.</description>
1704     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1705              IC_X_E(LC) = UNDEFINED
1706     !</keyword>
1707     
1708     !<keyword category="Initial Condition" required="false">
1709     !  <description>Y coordinate of the south face.</description>
1710     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1711              IC_Y_S(LC) = UNDEFINED
1712     !</keyword>
1713     
1714     !<keyword category="Initial Condition" required="false">
1715     !  <description>Y coordinate of the north face.</description>
1716     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1717              IC_Y_N(LC) = UNDEFINED
1718     !</keyword>
1719     
1720     !<keyword category="Initial Condition" required="false">
1721     !  <description>Z coordinate of the bottom face.</description>
1722     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1723              IC_Z_B(LC) = UNDEFINED
1724     !</keyword>
1725     
1726     !<keyword category="Initial Condition" required="false">
1727     !  <description>Z coordinate of the top face.</description>
1728     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1729              IC_Z_T(LC) = UNDEFINED
1730     !</keyword>
1731     
1732     !<keyword category="Initial Condition" required="false">
1733     !  <description>I index of the west-most wall.</description>
1734     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1735              IC_I_W(LC) = UNDEFINED_I
1736     !</keyword>
1737     
1738     !<keyword category="Initial Condition" required="false">
1739     !  <description>I index of the east-most wall.</description>
1740     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1741              IC_I_E(LC) = UNDEFINED_I
1742     !</keyword>
1743     
1744     !<keyword category="Initial Condition" required="false">
1745     !  <description>J index of the south-most wall.</description>
1746     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1747              IC_J_S(LC) = UNDEFINED_I
1748     !</keyword>
1749     
1750     !<keyword category="Initial Condition" required="false">
1751     !  <description>J index of the north-most wall.</description>
1752     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1753              IC_J_N(LC) = UNDEFINED_I
1754     !</keyword>
1755     
1756     !<keyword category="Initial Condition" required="false">
1757     !  <description>K index of the bottom-most wall.</description>
1758     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1759              IC_K_B(LC) = UNDEFINED_I
1760     !</keyword>
1761     
1762     !<keyword category="Initial Condition" required="false">
1763     !  <description>K index of the top-most wall.</description>
1764     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1765              IC_K_T(LC) = UNDEFINED_I
1766     !</keyword>
1767     
1768     !<keyword category="Initial Condition" required="false">
1769     !  <description>
1770     !    Type of initial condition. Mainly used in restart runs to overwrite
1771     !    values read from the .RES file by specifying it as _PATCH_. The
1772     !    user needs to be careful when using the _PATCH_ option, since the
1773     !    values from the .RES file are overwritten and no error checking is
1774     !    done for the patched values.
1775     !  </description>
1776     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1777              IC_TYPE(LC) = UNDEFINED_C
1778     !</keyword>
1779     
1780     !<keyword category="Initial Condition" required="false">
1781     !  <description>Initial void fraction in the IC region.</description>
1782     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1783              IC_EP_G(LC) = UNDEFINED
1784     !</keyword>
1785     
1786     !<keyword category="Initial Condition" required="false">
1787     !  <description>
1788     !    Initial gas pressure in the IC region. If this quantity is not
1789     !    specified, MFIX will set up a hydrostatic pressure profile,
1790     !    which varies only in the y-direction.
1791     !  </description>
1792     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1793              IC_P_G(LC) = UNDEFINED
1794     !</keyword>
1795     
1796     !<keyword category="Initial Condition" required="false">
1797     !  <description>
1798     !    Initial solids pressure in the IC region. Usually, this value is
1799     !    specified as zero.
1800     !  </description>
1801     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1802              IC_P_STAR(LC) = UNDEFINED
1803     !</keyword>
1804     
1805     !<keyword category="Initial Condition" required="false">
1806     !  <description>Turbulence length scale in the IC region.</description>
1807     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1808              IC_L_SCALE(LC) = UNDEFINED
1809     !</keyword>
1810     
1811     !<keyword category="Initial Condition" required="false">
1812     !  <description>
1813     !    Initial bulk density (rop_s = ro_s x ep_s) of solids phase-m in the
1814     !    IC region. Users need to specify this IC only for polydisperse flow
1815     !    (MMAX > 1). Users must make sure that summation of ( IC_ROP_s(ic,m)
1816     !    / RO_s(m) ) over all solids phases is equal to ( 1.0 - IC_EP_g(ic)).
1817     !  </description>
1818     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1819     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1820              IC_ROP_S(LC,:DIM_M) = UNDEFINED
1821     !</keyword>
1822     
1823     !<keyword category="Initial Condition" required="false">
1824     !  <description>
1825     !    Initial solids volume fraction of solids phase-m in the IC region.
1826     !    This may be specified in place of IC_ROP_s.
1827     !  </description>
1828     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1829     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1830              IC_EP_S(LC,:DIM_M) = UNDEFINED
1831     !</keyword>
1832     
1833     !<keyword category="Initial Condition" required="false">
1834     !  <description>Initial gas phase temperature in the IC region.</description>
1835     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1836              IC_T_G(LC) = UNDEFINED
1837     !</keyword>
1838     
1839     !<keyword category="Initial Condition" required="false">
1840     !  <description>Initial solids phase-m temperature in the IC region.</description>
1841     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1842     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1843              IC_T_S(LC,:DIM_M) = UNDEFINED
1844     !</keyword>
1845     
1846     !<keyword category="Initial Condition" required="false">
1847     !  <description>Initial solids phase-m granular temperature in the IC region.</description>
1848     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1849     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1850              IC_THETA_M(LC,:DIM_M) = UNDEFINED
1851     !</keyword>
1852     
1853     !<keyword category="Initial Condition" required="false">
1854     !  <description>
1855     !    Gas phase radiation coefficient in the IC region. Modify file
1856     !    rdtn2.inc to change the source term.
1857     !  </description>
1858     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1859     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1860              IC_GAMA_RG(LC) = ZERO
1861     !</keyword>
1862     
1863     !<keyword category="Initial Condition" required="false">
1864     !  <description>Gas phase radiation temperature in the IC region.</description>
1865     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1866     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1867              IC_T_RG(LC) = UNDEFINED
1868     !</keyword>
1869     
1870     !<keyword category="Initial Condition" required="false">
1871     !  <description>
1872     !    Solids phase-m radiation coefficient in the IC region. Modify file
1873     !    energy_mod.f to change the source term.
1874     !  </description>
1875     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1876     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1877              IC_GAMA_RS(LC,:DIM_M) = ZERO
1878     !</keyword>
1879     
1880     !<keyword category="Initial Condition" required="false">
1881     !  <description>Solids phase-m radiation temperature in the IC region.</description>
1882     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1883     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1884              IC_T_RS(LC,:DIM_M) = UNDEFINED
1885     !</keyword>
1886     
1887     !<keyword category="Initial Condition" required="false">
1888     !  <description>Initial x-component of gas velocity in the IC region.</description>
1889     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1890              IC_U_G(LC) = UNDEFINED
1891     !</keyword>
1892     
1893     !<keyword category="Initial Condition" required="false">
1894     !  <description>Initial x-component of solids-phase velocity in the IC region.</description>
1895     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1896     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1897              IC_U_S(LC,:DIM_M) = UNDEFINED
1898     !</keyword>
1899     
1900     !<keyword category="Initial Condition" required="false">
1901     !  <description>Initial y-component of gas velocity in the IC region.</description>
1902     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1903              IC_V_G(LC) = UNDEFINED
1904     !</keyword>
1905     
1906     !<keyword category="Initial Condition" required="false">
1907     !  <description>Initial y-component of solids-phase velocity in the IC region.</description>
1908     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1909     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1910              IC_V_S(LC,:DIM_M) = UNDEFINED
1911     !</keyword>
1912     
1913     !<keyword category="Initial Condition" required="false">
1914     !  <description>Initial z-component of gas velocity in the IC region.</description>
1915     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1916              IC_W_G(LC) = UNDEFINED
1917     !</keyword>
1918     
1919     !<keyword category="Initial Condition" required="false">
1920     !  <description>Initial z-component of solids-phase velocity in the IC region.</description>
1921     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1922     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1923              IC_W_S(LC,:DIM_M) = UNDEFINED
1924     !</keyword>
1925     
1926     !<keyword category="Initial Condition" required="false">
1927     !  <description>Initial mass fraction of gas species.</description>
1928     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1929     !  <arg index="2" id="Species" min="1" max="DIM_N_G"/>
1930              IC_X_G(LC,:DIM_N_G) = UNDEFINED
1931     !</keyword>
1932     
1933     !<keyword category="Initial Condition" required="false">
1934     !  <description>Initial mass fraction of solids species.</description>
1935     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1936     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1937     !  <arg index="3" id="Species" min="1" max="DIM_N_S"/>
1938              IC_X_S(LC,:DIM_M,:DIM_N_S) = UNDEFINED
1939     !</keyword>
1940     
1941     !<keyword category="Initial Condition" required="false">
1942     !  <description>Initial value of Scalar n.</description>
1943     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1944     !  <arg index="2" id="Scalar Eq." min="1" max="DIM_SCALAR"/>
1945             IC_SCALAR(LC,:DIM_SCALAR) = UNDEFINED
1946     !</keyword>
1947     
1948     !<keyword category="Initial Condition" required="false">
1949     !  <description>Initial value of K in K-Epsilon.</description>
1950     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1951              IC_K_Turb_G(LC) = UNDEFINED
1952     !</keyword>
1953     
1954     !<keyword category="Initial Condition" required="false">
1955     !  <description>Initial value of Epsilon in K-Epsilon.</description>
1956     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1957              IC_E_Turb_G(LC) = UNDEFINED
1958     !</keyword>
1959     
1960     !<keyword category="Initial Condition" required="false">
1961     !  <description>Flag for inflating initial lattice distribution
1962     ! to the entire IC region. </description>
1963     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1964               IC_DES_FIT_TO_REGION(LC) = .FALSE.
1965     !</keyword>
1966     
1967     
1968     !<keyword category="Initial Condition" required="false">
1969     !  <description>Flag to specify the initial constant number
1970     ! of particles per cell for the PIC method initialization.
1971     !Statistical weight of parcels will be calculated by the code.</description>
1972     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1973     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1974     !  <dependent keyword="SOLIDS_MODEL" value="PIC"/>
1975     !  <conflict keyword="IC_PIC_CONST_STATWT" value="DEFINED"/>
1976               IC_PIC_CONST_NPC(LC, :DIM_M) = 0
1977     !</keyword>
1978     
1979     
1980     !<keyword category="Initial Condition" required="false">
1981     !  <description>Flag to specify the initial constant statistical
1982     ! weight for computational particles/parcels. Actual number of
1983     ! parcels will be automatically computed. </description>
1984     !  <arg index="1" id="IC" min="1" max="DIMENSION_IC"/>
1985     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
1986     !  <dependent keyword="SOLIDS_MODEL" value="PIC"/>
1987     !  <conflict keyword="IC_PIC_CONST_NPC" value="DEFINED"/>
1988               IC_PIC_CONST_STATWT(LC, :DIM_M) = ZERO
1989     !</keyword>
1990           ENDDO
1991     
1992     
1993     
1994     
1995     !#####################################################################!
1996     !                        Boundary Conditions                          !
1997     !#####################################################################!
1998           DO LC = 1, DIMENSION_BC
1999     
2000     
2001     !<keyword category="Boundary Condition" required="false">
2002     !  <description>X coordinate of the west face or edge.</description>
2003     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2004              BC_X_W(LC) = UNDEFINED
2005     !</keyword>
2006     
2007     !<keyword category="Boundary Condition" required="false">
2008     !  <description>X coordinate of the east face or edge.</description>
2009     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2010              BC_X_E(LC) = UNDEFINED
2011     !</keyword>
2012     
2013     !<keyword category="Boundary Condition" required="false">
2014     !  <description>Y coordinate of the south face or edge.</description>
2015     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2016              BC_Y_S(LC) = UNDEFINED
2017     !</keyword>
2018     
2019     !<keyword category="Boundary Condition" required="false">
2020     !  <description>Y coordinate of the north face or edge.</description>
2021     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2022              BC_Y_N(LC) = UNDEFINED
2023     !</keyword>
2024     
2025     !<keyword category="Boundary Condition" required="false">
2026     !  <description>Z coordinate of the bottom face or edge.</description>
2027     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2028              BC_Z_B(LC) = UNDEFINED
2029     !</keyword>
2030     
2031     !<keyword category="Boundary Condition" required="false">
2032     !  <description>Z coordinate of the top face or edge.</description>
2033     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2034              BC_Z_T(LC) = UNDEFINED
2035     !</keyword>
2036     
2037     !<keyword category="Boundary Condition" required="false">
2038     !  <description>I index of the west-most cell.</description>
2039     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2040              BC_I_W(LC) = UNDEFINED_I
2041     !</keyword>
2042     
2043     !<keyword category="Boundary Condition" required="false">
2044     !  <description>I index of the east-most cell.</description>
2045     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2046              BC_I_E(LC) = UNDEFINED_I
2047     !</keyword>
2048     
2049     !<keyword category="Boundary Condition" required="false">
2050     !  <description>J index of the south-most cell.</description>
2051     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2052              BC_J_S(LC) = UNDEFINED_I
2053     !</keyword>
2054     
2055     !<keyword category="Boundary Condition" required="false">
2056     !  <description>J index of the north-most cell.</description>
2057     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2058              BC_J_N(LC) = UNDEFINED_I
2059     !</keyword>
2060     
2061     !<keyword category="Boundary Condition" required="false">
2062     !  <description>K index of the bottom-most cell.</description>
2063     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2064              BC_K_B(LC) = UNDEFINED_I
2065     !</keyword>
2066     
2067     !<keyword category="Boundary Condition" required="false">
2068     !  <description>K index of the top-most cell.</description>
2069     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2070              BC_K_T(LC) = UNDEFINED_I
2071     !</keyword>
2072     
2073     !<keyword category="Boundary Condition" required="false">
2074     !  <description>Type of boundary.</description>
2075     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2076     !
2077     !  <valid value='DUMMY'
2078     !    note='The specified boundary condition is ignored. This is
2079     !      useful for turning off some boundary conditions without having
2080     !      to delete them from the file.' />
2081     !
2082     !  <valid value='MASS_INFLOW' alias='MI'
2083     !    note='Mass inflow rates for gas and solids phases are
2084     !      specified at the boundary.'/>
2085     !
2086     !  <valid value='MASS_OUTFLOW' alias='MO'
2087     !    note='The specified values of gas and solids mass outflow
2088     !      rates at the boundary are maintained, approximately. This
2089     !      condition should be used sparingly for minor outflows, when
2090     !      the bulk of the outflow is occurring through other constant
2091     !      pressure outflow boundaries.' />
2092     !
2093     !  <valid value='P_INFLOW' alias='PI'
2094     !    note='Inflow from a boundary at a specified constant
2095     !      pressure. To specify as the west, south, or bottom end of
2096     !      the computational region, add a layer of wall cells to the
2097     !      west, south, or bottom of the PI cells. Users need to specify
2098     !      all scalar quantities and velocity components. The specified
2099     !      values of fluid and solids velocities are only used initially
2100     !      as MFIX computes these values at this inlet boundary.' />
2101     !
2102     !  <valid value='P_OUTFLOW' alias='PO'
2103     !    note='Outflow to a boundary at a specified constant pressure.
2104     !      To specify as the west, south, or bottom end of the computational
2105     !      region, add a layer of wall cells to the west, south, or bottom of
2106     !      the PO cells.' />
2107     !
2108     !  <valid value='FREE_SLIP_WALL' alias='FSW'
2109     !    note='Velocity gradients at the wall vanish. If BC_JJ_PS is
2110     !      equal to 1, the Johnson-Jackson boundary condition is used for
2111     !      solids.  A FSW is equivalent to using a PSW with hw=0.' />
2112     !
2113     !  <valid value='NO_SLIP_WALL' alias='NSW'
2114     !    note='All components of the velocity vanish at the wall. If
2115     !      BC_JJ_PS is equal to 1, the Johnson-Jackson boundary condition is
2116     !      used for solids.  A NSW is equivalent to using a PSW with vw=0
2117     !      and hw undefined.' />
2118     !
2119     !  <valid value='PAR_SLIP_WALL' alias='PSW'
2120     !    note='Partial slip at the wall implemented as
2121     !      dv/dn + hw (v - vw) = 0, where n is the normal pointing from the
2122     !      fluid into the wall. The coefficients hw and vw should be
2123     !      specified. For free slip set hw = 0. For no slip leave hw
2124     !      undefined (hw=+inf) and set vw = 0. To set hw = +inf, leave it
2125     !      unspecified. If BC_JJ_PS is equal to 1, the Johnson-Jackson
2126     !      boundary condition is used for solids.' />
2127              BC_TYPE(LC) = UNDEFINED_C
2128     !</keyword>
2129     
2130     !<keyword category="Boundary Condition" required="false">
2131     !  <description>Gas phase hw for partial slip boundary.</description>
2132     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2133              BC_HW_G(LC) = UNDEFINED
2134     !</keyword>
2135     
2136     !<keyword category="Boundary Condition" required="false">
2137     !  <description>Solids phase hw for partial slip boundary.</description>
2138     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2139     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2140              BC_HW_S(LC,:DIM_M) = UNDEFINED
2141     !</keyword>
2142     
2143     !<keyword category="Boundary Condition" required="false">
2144     !  <description>Gas phase Uw for partial slip boundary.</description>
2145     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2146              BC_UW_G(LC) = UNDEFINED
2147     !</keyword>
2148     
2149     !<keyword category="Boundary Condition" required="false">
2150     !  <description>Solids phase Uw for partial slip boundary.</description>
2151     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2152     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2153              BC_UW_S(LC,:DIM_M) = UNDEFINED
2154     !</keyword>
2155     
2156     !<keyword category="Boundary Condition" required="false">
2157     !  <description>Gas phase Vw for partial slip boundary.</description>
2158     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2159              BC_VW_G(LC) = UNDEFINED
2160     !</keyword>
2161     
2162     !<keyword category="Boundary Condition" required="false">
2163     !  <description>Solids phase Vw for partial slip boundary.</description>
2164     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2165     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2166              BC_VW_S(LC,:DIM_M) = UNDEFINED
2167     !</keyword>
2168     
2169     !<keyword category="Boundary Condition" required="false">
2170     !  <description>Gas phase Ww for partial slip boundary.</description>
2171     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2172              BC_WW_G(LC) = UNDEFINED
2173     !</keyword>
2174     
2175     !<keyword category="Boundary Condition" required="false">
2176     !  <description>Solids phase Ww for partial slip boundary.</description>
2177     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2178     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2179              BC_WW_S(LC,:DIM_M) = UNDEFINED
2180     !</keyword>
2181     
2182     !<keyword category="Boundary Condition" required="false">
2183     !  <description>
2184     !   Johnson and Jackson partial slip BC.
2185     !  </description>
2186     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2187     !  <valid value='0'
2188     !    note='Do not use Johnson and Jackson partial slip bc. Default
2189     !      if granular energy transport equation is not solved.'/>
2190     !  <valid value='1'
2191     !    note='Use Johnson and Jackson partial slip bc. Default if
2192     !      granular energy transport equation is solved.'/>
2193     !  <dependent keyword="GRANULAR_ENERGY" value=".TRUE."/>
2194              BC_JJ_PS(LC) = UNDEFINED_I
2195     !</keyword>
2196     
2197     !<keyword category="Boundary Condition" required="false">
2198     !  <description>Use a modified version of Johnson and Jackson
2199     !   partial slip BC (BC_JJ_PS BC) with a variable specularity
2200     !   coefficient.
2201     !  </description>
2202     !  <dependent keyword="E_w" value="DEFINED"/>
2203     !  <dependent keyword="PHI_w" value="DEFINED"/>
2204     !  <conflict keyword="JENKINS" value=".TRUE."/>
2205              BC_JJ_M = .FALSE.
2206     !</keyword>
2207     
2208     !<keyword category="Two Fluid Model" required="false">
2209     !  <description>
2210     !    This flag effects how the momentum and granular energy boundary
2211     !    conditions are implemented when using BC_JJ_PS BC.
2212     !  </description>
2213     !  <dependent keyword="PHI_w" value="DEFINED"/>
2214     !  <dependent keyword="E_w" value="DEFINED"/>
2215     !  <conflict keyword="BC_JJ_M" value=".TRUE."/>
2216     !  <valid value=".FALSE." note="Use standard boundary conditions."/>
2217     !  <valid value=".TRUE."
2218     !    note="Use Jenkins small frictional boundary condition."/>
2219              JENKINS = .FALSE.
2220     !</keyword>
2221     
2222     !<keyword category="Boundary Condition" required="false">
2223     !  <description>
2224     !    Specified wall value, THETAw_M, in diffusion boundary condition:
2225     !    d(Theta_M)/dn + Hw (THETA_M - THETAw_M) = C, where n is the fluid-to-wall normal.
2226     !  </description>
2227     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2228     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2229              BC_THETAW_M(LC,:DIM_M) = UNDEFINED
2230     !</keyword>
2231     
2232     !<keyword category="Boundary Condition" required="false">
2233     !  <description>
2234     !    Transfer coefficient, Hw, in diffusion boundary condition:
2235     !    d(Theta_M)/dn + Hw (THETA_M - THETAw_M) = C, where n is the fluid-to-wall normal.
2236     !  </description>
2237     !  <description>Hw for granular energy bc.</description>
2238     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2239     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2240              BC_HW_THETA_M(LC,:DIM_M) = UNDEFINED
2241     !</keyword>
2242     
2243     !<keyword category="Boundary Condition" required="false">
2244     !  <description>
2245     !    Specified constant flux, C, in diffusion boundary condition:
2246     !    d(Theta_M)/dn + Hw (THETA_M - THETAw_M) = C, where n is the fluid-to-wall normal.
2247     !  </description>
2248     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2249     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2250              BC_C_THETA_M(LC,:DIM_M) = UNDEFINED
2251     !</keyword>
2252     
2253     !<keyword category="Boundary Condition" required="false">
2254     !  <description>
2255     !    Gas phase heat transfer coefficient, Hw, in diffusion boundary condition:
2256     !    d(T_g)/dn + Hw (T_g - Tw_g) = C, where n is the fluid-to-wall normal.
2257     !  </description>
2258     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2259              BC_HW_T_G(LC) = UNDEFINED
2260     !</keyword>
2261     
2262     !<keyword category="Boundary Condition" required="false">
2263     !  <description>
2264     !    Specified gas phase wall temperature, Tw_g, in diffusion boundary condition:
2265     !    d(T_g)/dn + Hw (T_g - Tw_g) = C, where n is the fluid-to-wall normal.
2266     !  </description>
2267     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2268              BC_TW_G(LC) = UNDEFINED
2269     !</keyword>
2270     
2271     !<keyword category="Boundary Condition" required="false">
2272     !  <description>
2273     !    Specified constant gas phase heat flux, C, in diffusion boundary condition:
2274     !    d(T_g)/dn + Hw (T_g - Tw_g) = C, where n is the fluid-to-wall normal.
2275     !  </description>
2276     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2277              BC_C_T_G(LC) = UNDEFINED
2278     !</keyword>
2279     
2280     !<keyword category="Boundary Condition" required="false">
2281     !  <description>
2282     !    Solids phase heat transfer coefficient, Hw, in diffusion boundary condition:
2283     !    d(T_s)/dn + Hw (T_s - Tw_s) = C, where n is the fluid-to-wall normal.
2284     !  </description>
2285     !  <description>Solids phase hw for heat transfer.</description>
2286     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2287     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2288              BC_HW_T_S(LC,:DIM_M) = UNDEFINED
2289     !</keyword>
2290     
2291     !<keyword category="Boundary Condition" required="false">
2292     !  <description>
2293     !    Specified solids phase wall temperature, Tw_s, in diffusion boundary condition:
2294     !    d(T_s)/dn + Hw (T_s - Tw_s) = C, where n is the fluid-to-wall normal.
2295     !  </description>
2296     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2297     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2298              BC_TW_S(LC,:DIM_M) = UNDEFINED
2299     !</keyword>
2300     
2301     !<keyword category="Boundary Condition" required="false">
2302     !  <description>
2303     !    Specified constant solids phase heat flux, C, in diffusion boundary condition:
2304     !    d(T_s)/dn + Hw (T_s - Tw_s) = C, where n is the fluid-to-wall normal.
2305     !  </description>
2306     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2307     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2308              BC_C_T_S(LC,:DIM_M) = UNDEFINED
2309     !</keyword>
2310     
2311     !<keyword category="Boundary Condition" required="false">
2312     !  <description>
2313     !    Gas phase species mass transfer coefficient, Hw, in diffusion boundary condition:
2314     !    d(X_g)/dn + Hw (X_g - Xw_g) = C, where n is the fluid-to-wall normal.
2315     !  </description>
2316     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2317     !  <arg index="2" id="Species" min="1" max="DIM_N_G"/>
2318              BC_HW_X_G(LC,:DIM_N_G) = UNDEFINED
2319     !</keyword>
2320     
2321     !<keyword category="Boundary Condition" required="false">
2322     !  <description>
2323     !    Specified wall gas species mass fraction, Xw, in diffusion boundary condition:
2324     !    d(X_g)/dn + Hw (X_g - Xw_g) = C, where n is the fluid-to-wall normal.
2325     !  </description>
2326     !  <description>Gas phase Xw for mass transfer.</description>
2327     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2328     !  <arg index="2" id="Species" min="1" max="DIM_N_G"/>
2329              BC_XW_G(LC,:DIM_N_G) = UNDEFINED
2330     !</keyword>
2331     
2332     !<keyword category="Boundary Condition" required="false">
2333     !  <description>
2334     !    Specified constant gas species mass flux, C, in diffusion boundary condition:
2335     !    d(X_g)/dn + Hw (X_g - Xw_g) = C, where n is the fluid-to-wall normal.
2336     !  </description>
2337     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2338     !  <arg index="2" id="Species" min="1" max="DIM_N_G"/>
2339              BC_C_X_G(LC,:DIM_N_G) = UNDEFINED
2340     !</keyword>
2341     
2342     !<keyword category="Boundary Condition" required="false">
2343     !  <description>
2344     !    Solid phase species mass transfer coefficient, Hw, in diffusion boundary condition:
2345     !    d(X_s)/dn + Hw (X_s - Xw_s) = C, where n is the fluid-to-wall normal.
2346     !  </description>
2347     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2348     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2349     !  <arg index="3" id="Species" min="1" max="DIM_N_S"/>
2350              BC_HW_X_S(LC,:DIM_M,:DIM_N_S) = UNDEFINED
2351     !</keyword>
2352     
2353     !<keyword category="Boundary Condition" required="false">
2354     !  <description>
2355     !    Specified solids species mass fraction at the wall, Xw, in diffusion boundary condition:
2356     !    d(X_g)/dn + Hw (X_g - Xw_g) = C, where n is the fluid-to-wall normal.
2357     !  </description>
2358     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2359     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2360     !  <arg index="3" id="Species" min="1" max="DIM_N_S"/>
2361              BC_XW_S(LC,:DIM_M,:DIM_N_S) = UNDEFINED
2362     !</keyword>
2363     
2364     !<keyword category="Boundary Condition" required="false">
2365     !  <description>
2366     !    Specified constant solids species mass flux, C, in diffusion boundary condition:
2367     !    d(X_s)/dn + Hw (X_s - Xw_s) = C, where n is the fluid-to-wall normal.
2368     !  </description>
2369     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2370     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2371     !  <arg index="3" id="Species" min="1" max="DIM_N_S"/>
2372              BC_C_X_S(LC,:DIM_M,:DIM_N_S) = UNDEFINED
2373     !</keyword>
2374     
2375     !<keyword category="Boundary Condition" required="false">
2376     !  <description>
2377     !    Scalar transfer coefficient, Hw, in diffusion boundary condition:
2378     !    d(Scalar)/dn + Hw (Scalar - ScalarW) = C, where n is the fluid-to-wall normal.
2379     !  </description>
2380     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2381     !  <arg index="2" id="Scalar Eq." min="1" max="DIM_SCALAR"/>
2382              BC_HW_Scalar(LC,:DIM_SCALAR) = UNDEFINED
2383     !</keyword>
2384     
2385     !<keyword category="Boundary Condition" required="false">
2386     !  <description>
2387     !    Specified scalar value at the wall, ScalarW, in diffusion boundary condition:
2388     !    d(Scalar)/dn + Hw (Scalar - ScalarW) = C, where n is the fluid-to-wall normal.
2389     !  </description>
2390     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2391     !  <arg index="2" id="Scalar Eq." min="1" max="DIM_SCALAR"/>
2392              BC_ScalarW(LC,:DIM_SCALAR) = UNDEFINED
2393     !</keyword>
2394     
2395     !<keyword category="Boundary Condition" required="false">
2396     !  <description>
2397     !    Specified constant scalar flux, C, in diffusion boundary condition:
2398     !    d(Scalar)/dn + Hw (Scalar - ScalarW) = C, where n is the fluid-to-wall normal.
2399     !  </description>
2400     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2401     !  <arg index="2" id="Scalar Eq." min="1" max="DIM_SCALAR"/>
2402              BC_C_Scalar(LC,:DIM_SCALAR) = UNDEFINED
2403     !</keyword>
2404     
2405     !<keyword category="Boundary Condition" required="false">
2406     !  <description>Void fraction at the BC plane.</description>
2407     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2408              BC_EP_G(LC) = UNDEFINED
2409     !</keyword>
2410     
2411     !<keyword category="Boundary Condition" required="false">
2412     !  <description>Gas pressure at the BC plane.</description>
2413     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2414              BC_P_G(LC) = UNDEFINED
2415     !</keyword>
2416     
2417     !<keyword category="Boundary Condition" required="false">
2418     !  <description>Bulk density of solids phase at the BC plane.</description>
2419     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2420     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2421              BC_ROP_S(LC,:DIM_M) = UNDEFINED
2422     !</keyword>
2423     
2424     !<keyword category="Boundary Condition" required="false">
2425     !  <description>Solids volume fraction at the BC plane.</description>
2426     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2427     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2428              BC_EP_S(LC,:DIM_M) = UNDEFINED
2429     !</keyword>
2430     
2431     !<keyword category="Boundary Condition" required="false">
2432     !  <description>Gas phase temperature at the BC plane.</description>
2433     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2434              BC_T_G(LC) = UNDEFINED
2435     !</keyword>
2436     
2437     !<keyword category="Boundary Condition" required="false">
2438     !  <description>Solids phase-m temperature at the BC plane.</description>
2439     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2440     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2441              BC_T_S(LC,:DIM_M) = UNDEFINED
2442     !</keyword>
2443     
2444     !<keyword category="Boundary Condition" required="false">
2445     !  <description>Solids phase-m granular temperature at the BC plane.</description>
2446     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2447     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2448              BC_THETA_M(LC,:DIM_M) = UNDEFINED
2449     !</keyword>
2450     
2451     !<keyword category="Boundary Condition" required="false">
2452     !  <description>Mass fraction of gas species at the BC plane.</description>
2453     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2454     !  <arg index="2" id="Species" min="1" max="DIM_N_G"/>
2455              BC_X_G(LC,:DIM_N_G) = UNDEFINED
2456     !</keyword>
2457     
2458     !<keyword category="Boundary Condition" required="false">
2459     !  <description>Mass fraction of solids species at the BC plane.</description>
2460     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2461     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2462     !  <arg index="3" id="Species" min="1" max="DIM_N_S"/>
2463              BC_X_S(LC,:DIM_M,:DIM_N_S) = UNDEFINED
2464     !</keyword>
2465     
2466     !<keyword category="Boundary Condition" required="false">
2467     !  <description>X-component of gas velocity at the BC plane.</description>
2468     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2469              BC_U_G(LC) = UNDEFINED
2470     !</keyword>
2471     
2472     !<keyword category="Boundary Condition" required="false">
2473     !  <description>X-component of solids-phase velocity at the BC plane.</description>
2474     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2475     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2476              BC_U_S(LC,:DIM_M) = UNDEFINED
2477     !</keyword>
2478     
2479     !<keyword category="Boundary Condition" required="false">
2480     !  <description>Y-component of gas velocity at the BC plane.</description>
2481     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2482              BC_V_G(LC) = UNDEFINED
2483     !</keyword>
2484     
2485     !<keyword category="Boundary Condition" required="false">
2486     !  <description>Y-component of solids-phase velocity at the BC plane.</description>
2487     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2488     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2489              BC_V_S(LC,:DIM_M) = UNDEFINED
2490     !</keyword>
2491     
2492     !<keyword category="Boundary Condition" required="false">
2493     !  <description>Z-component of gas velocity at the BC plane.</description>
2494     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2495              BC_W_G(LC) = UNDEFINED
2496     !</keyword>
2497     
2498     !<keyword category="Boundary Condition" required="false">
2499     !  <description>Z-component of solids-phase velocity at the BC plane.</description>
2500     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2501     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2502              BC_W_S(LC,:DIM_M) = UNDEFINED
2503     !</keyword>
2504     
2505     !<keyword category="Boundary Condition" required="false">
2506     !  <description>Gas volumetric flow rate through the boundary.</description>
2507     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2508              BC_VOLFLOW_G(LC) = UNDEFINED
2509     !</keyword>
2510     
2511     !<keyword category="Boundary Condition" required="false">
2512     !  <description>Solids volumetric flow rate through the boundary.</description>
2513     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2514     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2515              BC_VOLFLOW_S(LC,:DIM_M) = UNDEFINED
2516     !</keyword>
2517     
2518     !<keyword category="Boundary Condition" required="false">
2519     !  <description>Gas mass flow rate through the boundary.</description>
2520     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2521              BC_MASSFLOW_G(LC) = UNDEFINED
2522     !</keyword>
2523     
2524     !<keyword category="Boundary Condition" required="false">
2525     !  <description>Solids mass flow rate through the boundary.</description>
2526     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2527     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2528              BC_MASSFLOW_S(LC,:DIM_M) = UNDEFINED
2529     !</keyword>
2530     
2531     !<keyword category="Boundary Condition" required="false">
2532     !  <description>The interval at the beginning when the normal
2533     !    velocity at the boundary is equal to BC_Jet_g0. When restarting,
2534     !    run this value and BC_Jet_g0 should be specified such that the
2535     !    transient jet continues correctly. MFIX does not store the jet
2536     !    conditions. For MASS_OUTFLOW boundary conditions, BC_DT_0 is
2537     !    the time period to average and print the outflow rates. The
2538     !    adjustment of velocities to get a specified mass or volumetric
2539     !    flow rate is based on the average outflow rate.
2540     !  </description>
2541     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2542              BC_DT_0(LC) = UNDEFINED
2543     !</keyword>
2544     
2545     !<keyword category="Boundary Condition" required="false">
2546     !  <description>Value of normal velocity during the initial interval BC_DT_0.</description>
2547     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2548              BC_JET_G0(LC) = UNDEFINED
2549     !</keyword>
2550     
2551     !<keyword category="Boundary Condition" required="false">
2552     !  <description>The interval when normal velocity is equal to BC_Jet_gh.</description>
2553     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2554              BC_DT_H(LC) = UNDEFINED
2555     !</keyword>
2556     
2557     !<keyword category="Boundary Condition" required="false">
2558     !  <description>Value of normal velocity during the interval BC_DT_h.</description>
2559     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2560              BC_JET_GH(LC) = UNDEFINED
2561     !</keyword>
2562     
2563     !<keyword category="Boundary Condition" required="false">
2564     !  <description>The interval when normal velocity is equal to BC_JET_gL.</description>
2565     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2566              BC_DT_L(LC) = UNDEFINED
2567     !</keyword>
2568     
2569     !<keyword category="Boundary Condition" required="false">
2570     !  <description>Value of normal velocity during the interval BC_DT_L.</description>
2571     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2572              BC_JET_GL(LC) = UNDEFINED
2573     !</keyword>
2574     
2575     !<keyword category="Boundary Condition" required="false">
2576     !  <description>Boundary value for user-defined scalar equation.</description>
2577     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2578     !  <arg index="2" id="Scalar Eq." min="1" max="DIM_SCALAR"/>
2579              BC_Scalar(LC,:DIM_SCALAR) = UNDEFINED
2580     !</keyword>
2581     
2582     !<keyword category="Boundary Condition" required="false">
2583     !  <description>Boundary value of K for K-Epsilon Equation.</description>
2584     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2585              BC_K_Turb_G(LC) = UNDEFINED
2586     !</keyword>
2587     
2588     !<keyword category="Boundary Condition" required="false">
2589     !  <description>Boundary value of Epsilon for K-Epsilon Equation.</description>
2590     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2591              BC_E_Turb_G(LC) = UNDEFINED
2592     !</keyword>
2593     
2594     !<keyword category="Boundary Condition" required="false">
2595     !  <description>Magnitude of gas velocity in a specified boundary region.</description>
2596     !  <dependent keyword="CARTESIAN_GRID" value=".TRUE."/>
2597     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2598              BC_VELMAG_G(LC) = UNDEFINED
2599     !</keyword>
2600     
2601     !<keyword category="Boundary Condition" required="false">
2602     !  <description>Magnitude of gas velocity in a specified boundary region.</description>
2603     !  <dependent keyword="CARTESIAN_GRID" value=".TRUE."/>
2604     !  <arg index="1" id="BC" min="1" max="DIMENSION_BC"/>
2605     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2606              BC_VELMAG_S(LC,:DIM_M) = UNDEFINED
2607     !</keyword>
2608     
2609     !<keyword category="Boundary Condition" required="false">
2610     !  <description>Flag to specify the constant number
2611     ! of computational particles per cell for the PIC solids inflow BC.
2612     !Statistical weight of parcels will be calculated by the code.</description>
2613     !  <arg index="1" id="BC" min="1" max="DIMENSION_IC"/>
2614     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2615     !  <conflict keyword="BC_PIC_CONST_STATWT" value="DEFINED"/>
2616     !  <dependent keyword="SOLIDS_MODEL" value="PIC"/>
2617               BC_PIC_MI_CONST_NPC(LC, :DIM_M) = 0
2618     !</keyword>
2619     
2620     
2621     !<keyword category="Boundary Condition" required="false">
2622     !  <description>Flag to specify the constant statistical
2623     ! weight for inflowing computational particles/parcels. Actual number of
2624     ! parcels will be automatically computed. </description>
2625     !  <arg index="1" id="BC" min="1" max="DIMENSION_IC"/>
2626     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2627     !  <conflict keyword="IC_PIC_CONST_NPC" value="DEFINED"/>
2628               BC_PIC_MI_CONST_STATWT(LC, :DIM_M) = ZERO
2629     !</keyword>
2630     
2631     !<keyword category="Boundary Condition" required="false">
2632     !  <description>Flag to make the PO BC invisible to discrete solids.
2633     ! Set this flag to.FALSE.to remove this BC for discrete solids. </description>
2634     !  <arg index="1" id="BC" min="1" max="DIMENSION_IC"/>
2635              BC_PO_APPLY_TO_DES(LC) = .TRUE.
2636     !</keyword>
2637     
2638     
2639              BC_ROP_G(LC) = UNDEFINED
2640           ENDDO
2641     
2642     
2643     
2644     
2645     !#####################################################################!
2646     !                         Internal Surfaces                           !
2647     !#####################################################################!
2648           DO LC = 1, DIMENSION_IS
2649     
2650     
2651     !<keyword category="Internal Surface" required="false">
2652     !  <description>X coordinate of the west face or edge.</description>
2653     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2654              IS_X_W(LC) = UNDEFINED
2655     !</keyword>
2656     
2657     !<keyword category="Internal Surface" required="false">
2658     !  <description>X coordinate of the east face or edge.</description>
2659     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2660              IS_X_E(LC) = UNDEFINED
2661     !</keyword>
2662     
2663     !<keyword category="Internal Surface" required="false">
2664     !  <description>Y coordinate of the south face or edge</description>
2665     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2666              IS_Y_S(LC) = UNDEFINED
2667     !</keyword>
2668     
2669     !<keyword category="Internal Surface" required="false">
2670     !  <description>Y coordinate of the north face or edge</description>
2671     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2672              IS_Y_N(LC) = UNDEFINED
2673     !</keyword>
2674     
2675     !<keyword category="Internal Surface" required="false">
2676     !  <description>Z coordinate of the bottom face or edge</description>
2677     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2678              IS_Z_B(LC) = UNDEFINED
2679     !</keyword>
2680     
2681     !<keyword category="Internal Surface" required="false">
2682     !  <description>Z coordinate of the top face or edge</description>
2683     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2684              IS_Z_T(LC) = UNDEFINED
2685     !</keyword>
2686     
2687     !<keyword category="Internal Surface" required="false">
2688     !  <description>I index of the west-most cell.</description>
2689     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2690              IS_I_W(LC) = UNDEFINED_I
2691     !</keyword>
2692     
2693     !<keyword category="Internal Surface" required="false">
2694     !  <description>I index of the east-most cell</description>
2695     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2696              IS_I_E(LC) = UNDEFINED_I
2697     !</keyword>
2698     
2699     !<keyword category="Internal Surface" required="false">
2700     !  <description>J index of the south-most cell</description>
2701     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2702              IS_J_S(LC) = UNDEFINED_I
2703     !</keyword>
2704     
2705     !<keyword category="Internal Surface" required="false">
2706     !  <description>J index of the north-most cell</description>
2707     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2708              IS_J_N(LC) = UNDEFINED_I
2709     !</keyword>
2710     
2711     !<keyword category="Internal Surface" required="false">
2712     !  <description>K index of the bottom-most cell</description>
2713     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2714              IS_K_B(LC) = UNDEFINED_I
2715     !</keyword>
2716     
2717     !<keyword category="Internal Surface" required="false">
2718     !  <description>K index of the top-most cell</description>
2719     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2720              IS_K_T(LC) = UNDEFINED_I
2721     !</keyword>
2722     
2723     !<keyword category="Internal Surface" required="false">
2724     !  <description>Type of internal surface</description>
2725     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2726     !  <valid value="IMPERMEABLE"
2727     !    note="No gas or solids flow through the surface." alias="IP"/>
2728     !  <valid value="SEMIPERMEABLE" alias='SP'
2729     !    note="Gas flows through the surface with an additional resistance.
2730     !      Solids velocity through the surface is set to zero or to a user-
2731     !      specified fixed value (i.e., solids momentum equation for this
2732     !      direction is not solved)." />
2733              IS_TYPE(LC) = UNDEFINED_C
2734     !</keyword>
2735     
2736     !<keyword category="Internal Surface" required="false">
2737     !  <description>
2738     !    Parameters defining the internal surface. These values need to be
2739     !    specified for semipermeable surfaces only. The thickness used for
2740     !    pressure drop computation is that of the momentum cell (DX_e,
2741     !    DY_n, or DZ_t). To turn off the resistance, use a large value
2742     !    for permeability.
2743     !    o IDX=1: Permeability [1.0E32]
2744     !    o IDX=2: Inertial resistance coefficient [0.0]
2745     !  </description>
2746     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2747     !  <arg index="2" id="IDX" min="1" max="2"/>
2748              IS_PC(LC,1) = UNDEFINED
2749              IS_PC(LC,2) = ZERO
2750     !</keyword>
2751     
2752     !<keyword category="Internal Surface" required="false">
2753     !  <description>Value of fixed solids velocity through semipermeable surfaces.</description>
2754     !  <arg index="1" id="IS" min="1" max="DIMENSION_IS"/>
2755     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2756              IS_VEL_S(LC,:DIM_M) = ZERO
2757     !</keyword>
2758           ENDDO
2759     
2760     
2761     !#####################################################################!
2762     !                     Point Source Mass Inlets                        !
2763     !#####################################################################!
2764           DO LC = 1, DIMENSION_PS
2765     
2766     !<keyword category="Point Source" required="false">
2767     !  <description>X coordinate of the west face or edge.</description>
2768     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2769              PS_X_W(LC) = UNDEFINED
2770     !</keyword>
2771     
2772     !<keyword category="Point Source" required="false">
2773     !  <description>X coordinate of the east face or edge.</description>
2774     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2775              PS_X_E(LC) = UNDEFINED
2776     !</keyword>
2777     
2778     !<keyword category="Point Source" required="false">
2779     !  <description>Y coordinate of the south face or edge.</description>
2780     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2781              PS_Y_S(LC) = UNDEFINED
2782     !</keyword>
2783     
2784     !<keyword category="Point Source" required="false">
2785     !  <description>Y coordinate of the north face or edge.</description>
2786     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2787              PS_Y_N(LC) = UNDEFINED
2788     !</keyword>
2789     
2790     !<keyword category="Point Source" required="false">
2791     !  <description>Z coordinate of the bottom face or edge.</description>
2792     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2793              PS_Z_B(LC) = UNDEFINED
2794     !</keyword>
2795     
2796     !<keyword category="Point Source" required="false">
2797     !  <description>Z coordinate of the top face or edge.</description>
2798     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2799              PS_Z_T(LC) = UNDEFINED
2800     !</keyword>
2801     
2802     !<keyword category="Point Source" required="false">
2803     !  <description>I index of the west-most cell.</description>
2804     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2805              PS_I_W(LC) = UNDEFINED_I
2806     !</keyword>
2807     
2808     !<keyword category="Point Source" required="false">
2809     !  <description>I index of the east-most cell.</description>
2810     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2811              PS_I_E(LC) = UNDEFINED_I
2812     !</keyword>
2813     
2814     !<keyword category="Point Source" required="false">
2815     !  <description>J index of the south-most cell.</description>
2816     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2817              PS_J_S(LC) = UNDEFINED_I
2818     !</keyword>
2819     
2820     !<keyword category="Point Source" required="false">
2821     !  <description>J index of the north-most cell.</description>
2822     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2823              PS_J_N(LC) = UNDEFINED_I
2824     !</keyword>
2825     
2826     !<keyword category="Point Source" required="false">
2827     !  <description>K index of the bottom-most cell.</description>
2828     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2829              PS_K_B(LC) = UNDEFINED_I
2830     !</keyword>
2831     
2832     !<keyword category="Point Source" required="false">
2833     !  <description>K index of the top-most cell.</description>
2834     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2835              PS_K_T(LC) = UNDEFINED_I
2836     !</keyword>
2837     
2838     
2839     !<keyword category="Point Source" required="false">
2840     !  <description>X-component of incoming gas velocity.</description>
2841     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2842              PS_U_G(LC) = UNDEFINED
2843     !</keyword>
2844     
2845     !<keyword category="Point Source" required="false">
2846     !  <description>Y-component of incoming gas velocity.</description>
2847     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2848              PS_V_G(LC) = UNDEFINED
2849     !</keyword>
2850     
2851     !<keyword category="Point Source" required="false">
2852     !  <description>Z-component of incoming gas velocity.</description>
2853     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2854              PS_W_G(LC) = UNDEFINED
2855     !</keyword>
2856     
2857     !<keyword category="Point Source" required="false">
2858     !  <description>Gas mass flow rate through the point source.</description>
2859     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2860              PS_MASSFLOW_G(LC) = UNDEFINED
2861     !</keyword>
2862     
2863     !<keyword category="Point Source" required="false">
2864     !  <description>Temperature of incoming gas.</description>
2865     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2866              PS_T_G(LC) = UNDEFINED
2867     !</keyword>
2868     
2869     !<keyword category="Point Source" required="false">
2870     !  <description>Gas phase incoming species n mass fraction.</description>
2871     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2872     !  <arg index="2" id="Species" min="1" max="DIM_N_G"/>
2873              PS_X_G(LC,:DIM_N_g) = UNDEFINED
2874     !</keyword>
2875     
2876     !<keyword category="Point Source" required="false">
2877     !  <description>X-component of incoming solids velocity.</description>
2878     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2879     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2880              PS_U_S(LC,:DIM_M) = UNDEFINED
2881     !</keyword>
2882     
2883     !<keyword category="Point Source" required="false">
2884     !  <description>Y-component of incoming solids velocity.</description>
2885     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2886     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2887              PS_V_S(LC,:DIM_M) = UNDEFINED
2888     !</keyword>
2889     
2890     !<keyword category="Point Source" required="false">
2891     !  <description>Z-component of incoming solids velocity.</description>
2892     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2893     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2894              PS_W_S(LC,:DIM_M) = UNDEFINED
2895     !</keyword>
2896     
2897     !<keyword category="Point Source" required="false">
2898     !  <description>Solids mass flow rate through the point source.</description>
2899     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2900     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2901              PS_MASSFLOW_S(LC,:DIM_M) = UNDEFINED
2902     !</keyword>
2903     
2904     !<keyword category="Point Source" required="false">
2905     !  <description>Temperature of incoming solids.</description>
2906     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2907     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2908              PS_T_S(LC,:DIM_M) = UNDEFINED
2909     !</keyword>
2910     
2911     !<keyword category="Point Source" required="false">
2912     !  <description>Solids phase incoming species n mass fraction.</description>
2913     !  <arg index="1" id="PS" min="1" max="DIMENSION_PS"/>
2914     !  <arg index="2" id="Phase" min="1" max="DIM_M"/>
2915     !  <arg index="3" id="Species" min="1" max="DIM_N_S"/>
2916              PS_X_S(LC,:DIM_M,:DIM_N_S) = UNDEFINED
2917     !</keyword>
2918     
2919           ENDDO
2920     
2921     
2922     !#####################################################################!
2923     !                          Output Control                             !
2924     !#####################################################################!
2925     
2926     !<keyword category="Output Control" required="true">
2927     !  <description>
2928     !    Interval at which restart (.res) file is updated.
2929     !  </description>
2930           RES_DT = UNDEFINED
2931     !</keyword>
2932     
2933     !<keyword category="Output Control" required="false">
2934     !  <description>
2935     !    Interval at which a backup copy of the restart file is created.
2936     !  </description>
2937           RES_BACKUP_DT = UNDEFINED
2938     !</keyword>
2939     
2940     !<keyword category="Output Control" required="false">
2941     !  <description>
2942     !    The number of backup restart files to retain.
2943     !  </description>
2944           RES_BACKUPS = UNDEFINED_I
2945     !</keyword>
2946     
2947     !<keyword category="Output Control" required="false">
2948     !  <description>
2949     !    Interval at which .SPX files are updated.
2950     !    o SP1: void fraction (EP_G)
2951     !    o SP2: Gas pressure (P_G) and Solids pressure (P_star)
2952     !    o SP3: Gas velocity (U_G, V_G, W_G)
2953     !    o SP4: Solids velocity (U_S, V_S, W_S)
2954     !    o SP5: Solids bulk density (ROP_s)
2955     !    o SP6: Gas and solids temperature (T_G, T_S)
2956     !    o SP7: Gas and solids mass fractions (X_G, X_S)
2957     !    o SP8: Granular temperature (THETA_M)
2958     !    o SP9: User defined scalars. (SCALAR)
2959     !    o SPA: Reaction Rates (ReactionRates)
2960     !    o SPB: Turbulence quantities (K_TURB_G, E_TURB_G)
2961     !  </description>
2962     !  <arg index="1" id="SP Value" min="1" max="N_SPX"/>
2963           SPX_DT(:N_SPX) = UNDEFINED
2964     !</keyword>
2965     
2966     !<keyword category="Output Control" required="false">
2967     !  <description>
2968     !    The number of user defined chemical reactions stored
2969     !    in the *.SPA file.
2970     !  </description>
2971           nRR = 0
2972     !</keyword>
2973     
2974     !<keyword category="Output Control" required="false">
2975     !  <description> Interval at which standard output (.OUT) file is updated.
2976     !    Only run configuration information is written if left undefined. Otherwise
2977     !    all field variables for the entire domain are written in ASCII
2978     !    format to the .OUT file at OUT_DT intervals.
2979     !  </description>
2980           OUT_DT = UNDEFINED
2981     !</keyword>
2982     
2983     !<keyword category="Output Control" required="false">
2984     !  <description>Number of time steps between .LOG file updates.</description>
2985           NLOG = 25
2986     !</keyword>
2987     
2988     !<keyword category="Output Control" required="false">
2989     !  <description> Display the residuals on the screen and provide
2990     !    messages about convergence on the screen and in the .LOG file.
2991     !  </description>
2992           FULL_LOG = .FALSE.
2993     !</keyword>
2994     
2995     !<keyword category="Output Control" required="false">
2996     !  <description>Specifies the residuals to display. </description>
2997     !  <arg index="1" id="Residual Index" max="8" min="1"/>
2998     !  <valid value="P0" note="Gas pressure"/>
2999     !  <valid value="PM" note="Solids phase M pressure"/>
3000     !  <valid value="R0" note="Gas density"/>
3001     !  <valid value="RM" note="Solids phase M density"/>
3002     !  <valid value="U0" note="Gas phase U-velocity"/>
3003     !  <valid value="V0" note="Gas phase V-velocity"/>
3004     !  <valid value="W0" note="Gas phase W-velocity"/>
3005     !  <valid value="UM" note="Solids phase M U-velocity"/>
3006     !  <valid value="VM" note="Solids phase M V-velocity"/>
3007     !  <valid value="WM" note="Solids phase M W-velocity"/>
3008     !  <valid value="T0" note="Gas temperature"/>
3009     !  <valid value="TM" note="Solids phase M temperature"/>
3010     !  <valid value="X0NN" note="Gas phase species NN mass fraction"/>
3011     !  <valid value="XMNN" note="Solids phase M species NN mass fraction"/>
3012     !  <valid value="K0" note="K-Epsilon model residuals"/>
3013           RESID_STRING(:8) = UNDEFINED_C
3014     !</keyword>
3015     
3016     !<keyword category="Output Control" required="false">
3017     !  <description>Display residuals by equation.  </description>
3018           GROUP_RESID = .FALSE.
3019     !</keyword>
3020     
3021     
3022     !<keyword category="Output Control" required="false">
3023     !  <description>
3024     !    Provide detailed logging of negative density errors.
3025     !  </description>
3026     !  <valid value=".FALSE." note="Do not log negative density errors."/>
3027     !  <valid value=".TRUE." note="Log negative density errors."/>
3028           REPORT_NEG_DENSITY = .FALSE.
3029     !</keyword>
3030     
3031     !<keyword category="Output Control" required="false">
3032     !  <description>
3033     !    Frequency to perform an overall species mass balance. Leaving
3034     !    undefined suppresses the mass balance calculations which can
3035     !    slightly extend run time.
3036     !  </description>
3037           REPORT_MASS_BALANCE_DT = UNDEFINED
3038     !</keyword>
3039     
3040     !<keyword category="Output Control" required="false">
3041     !  <description>
3042     !    Output the variable specularity coefficient when BC_JJ_M is
3043     !    .TRUE.. The specularity coefficient will be stored in ReactionRates
3044     !    array for post-processing by post-mfix. User needs to set NRR to 1
3045     !    for this purpose. Be careful with this setting when reacting flow
3046     !    is simulated.
3047     !  </description>
3048           PHIP_OUT_JJ=.FALSE.
3049     !</keyword>
3050     
3051     !<keyword category="Output Control" required="false">
3052     !  <description>
3053     !    Use distributed IO :: Each MPI process generates RES/SPx files.
3054     !  </description>
3055           bDist_IO = .FALSE.
3056     !</keyword>
3057     
3058     !<keyword category="Output Control" required="false">
3059     !  <description>
3060     !    Restart a serial IO run (only one RES file was created) with
3061     !    distributed IO.
3062     !  </description>
3063     !  <dependent keyword="RUN_TYPE" value="RESTART_2"/>
3064     !  <dependent keyword="bDist_IO" value=".TRUE."/>
3065           bStart_with_one_RES = .FALSE.
3066     !</keyword>
3067     
3068     !<keyword category="Output Control" required="false">
3069     !  <description>
3070     !    Flag to write variable in NetCDF output file. NetCDF support is not
3071     !    included in MFIX by default. The executable must be compiled and
3072     !    linked with an appropriate NetCDF library to use this functionality.
3073     !
3074     !    Variable Index List:
3075     !     1: void fraction (EP_G)
3076     !     2: Gas pressure (P_G)
3077     !     3: Solids pressure (P_star)
3078     !     4: Gas velocity (U_G, V_G, W_G)
3079     !     5: Solids velocity (U_S, V_S, W_S)
3080     !     6: Solids bulk density (ROP_s)
3081     !     7: Gas temperature (T_G)
3082     !     8: Gas and solids temperature (T_S)
3083     !     9: Gas mass fractions (X_G)
3084     !    10: Solids mass fractions (X_S)
3085     !    11: Granular temperature (THETA_M)
3086     !    12: User defined scalars. (SCALAR)
3087     !    13: Reaction Rates (ReactionRates)
3088     !    14: Turbulence quantities (K_TURB_G, E_TURB_G)
3089     !  </description>
3090     !  <arg index="1" id="NetCDF Variable Reference" max="20" min="1"/>
3091     !  <valid value=".TRUE." note="Write variable in NetCDF output."/>
3092     !  <valid value=".FALSE." note="Do not include variable in NetCDF output."/>
3093           bWrite_netCDF(:20) = .FALSE.
3094     !</keyword>
3095     
3096     
3097     !#####################################################################!
3098     !                           UDF  Control                              !
3099     !#####################################################################!
3100     
3101     !<keyword category="UDF Control" required="false">
3102     !  <description>
3103     !    Flag to enable user-defined subroutines: USR0, USR1, USR2, USR3,
3104     !    USR0_DES, USR1_DES, USR2_DES, USR3_DES, USR4_DES.
3105     !  </description>
3106     !  <valid value=".TRUE." note="Call user-defined subroutines."/>
3107     !  <valid value=".FALSE." note="Do NOT call user-defined subroutines."/>
3108           CALL_USR = .FALSE.
3109     !</keyword>
3110     
3111     !<keyword category="UDF Control" required="false">
3112     !  <description>
3113     !    Flag to use the User Defined Function, USR_PHYSICAL_PROP_ROg,
3114     !    in model/usr_physical_prop.f  for calculating the gas phase
3115     !    density, RO_g.
3116     !  </description>
3117     !  <valid value=".TRUE." note="Call user-defined function."/>
3118     !  <valid value=".FALSE." note="Use MFIX default calculation."/>
3119           USR_ROg = .FALSE.
3120     !</keyword>
3121     
3122     !<keyword category="UDF Control" required="false">
3123     !  <description>
3124     !    Flag to use the User Defined Function, USR_PHYSICAL_PROP_CPg,
3125     !    in model/usr_physical_prop.f  for calculating the gas phase
3126     !    constant pressure specific heat, C_PG.
3127     !  </description>
3128     !  <valid value=".TRUE." note="Call user-defined function."/>
3129     !  <valid value=".FALSE." note="Use MFIX default calculation."/>
3130           USR_CPg = .FALSE.
3131     !</keyword>
3132     
3133     !<keyword category="UDF Control" required="false" tfm="true">
3134     !  <description>
3135     !    Flag to use the User Defined Function, USR_PHYSICAL_PROP_ROs,
3136     !    in model/usr_physical_prop.f  for calculating the solids phase
3137     !    density, RO_s.
3138     !  </description>
3139     !  <valid value=".TRUE." note="Call user-defined function."/>
3140     !  <valid value=".FALSE." note="Use MFIX default calculation."/>
3141           USR_ROs = .FALSE.
3142     !</keyword>
3143     
3144     !<keyword category="UDF Control" required="false" tfm="true">
3145     !  <description>
3146     !    Flag to use the User Defined Function, USR_PHYSICAL_PROP_CPs,
3147     !    in model/usr_physical_prop.f  for calculating the solids phase
3148     !    constant pressure specific heat, C_PS.
3149     !  </description>
3150     !  <valid value=".TRUE." note="Call user-defined function."/>
3151     !  <valid value=".FALSE." note="Use MFIX default calculation."/>
3152           USR_CPs = .FALSE.
3153     !</keyword>
3154     
3155     !<keyword category="UDF Control" required="false">
3156     !  <description>User defined constants.</description>
3157           C(:DIMENSION_C) = UNDEFINED
3158     !</keyword>
3159     
3160     !<keyword category="UDF Control" required="false">
3161     !  <description>Name of user-defined constant. (20 character max)</description>
3162           C_NAME(:DIMENSION_C) = '....................'
3163     !</keyword>
3164     
3165           DO LC=1, DIMENSION_USR
3166     !<keyword category="UDF Control" required="false">
3167     !  <description>
3168     !    Intervals at which subroutine write_usr1 is called.
3169     !  </description>
3170     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3171              USR_DT(LC) = UNDEFINED
3172     !</keyword>
3173     
3174     !<keyword category="UDF Control" required="false">
3175     !  <description>Udf Hook: x coordinate of the west face or edge.</description>
3176     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3177              USR_X_W(LC) = UNDEFINED
3178     !</keyword>
3179     
3180     !<keyword category="UDF Control" required="false">
3181     !  <description>Udf Hook: x coordinate of the east face or edge.</description>
3182     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3183              USR_X_E(LC) = UNDEFINED
3184     !</keyword>
3185     
3186     !<keyword category="UDF Control" required="false">
3187     !  <description>Udf Hook: y coordinate of the south face or edge.</description>
3188     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3189              USR_Y_S(LC) = UNDEFINED
3190     !</keyword>
3191     
3192     !<keyword category="UDF Control" required="false">
3193     !  <description>Udf Hook: y coordinate of the north face or edge.</description>
3194     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3195              USR_Y_N(LC) = UNDEFINED
3196     !</keyword>
3197     
3198     !<keyword category="UDF Control" required="false">
3199     !  <description>Udf Hook: z coordinate of the bottom face or edge.</description>
3200     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3201              USR_Z_B(LC) = UNDEFINED
3202     !</keyword>
3203     
3204     !<keyword category="UDF Control" required="false">
3205     !  <description>Udf Hook: z coordinate of the top face or edge.</description>
3206     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3207              USR_Z_T(LC) = UNDEFINED
3208     !</keyword>
3209     
3210     !<keyword category="UDF Control" required="false">
3211     !  <description>Udf Hook: i index of the west-most cell.</description>
3212     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3213              USR_I_W(LC) = UNDEFINED_I
3214     !</keyword>
3215     
3216     !<keyword category="UDF Control" required="false">
3217     !  <description>Udf Hook: i index of the east-most cell.</description>
3218     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3219              USR_I_E(LC) = UNDEFINED_I
3220     !</keyword>
3221     
3222     !<keyword category="UDF Control" required="false">
3223     !  <description>Udf Hook: j index of the south-most cell.</description>
3224     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3225              USR_J_S(LC) = UNDEFINED_I
3226     !</keyword>
3227     
3228     !<keyword category="UDF Control" required="false">
3229     !  <description>Udf Hook: j index of the north-most cell.</description>
3230     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3231              USR_J_N(LC) = UNDEFINED_I
3232     !</keyword>
3233     
3234     !<keyword category="UDF Control" required="false">
3235     !  <description>Udf Hook: k index of the bottom-most cell.</description>
3236     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3237              USR_K_B(LC) = UNDEFINED_I
3238     !</keyword>
3239     
3240     !<keyword category="UDF Control" required="false">
3241     !  <description>Udf Hook: k index of the top-most cell.</description>
3242     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3243              USR_K_T(LC) = UNDEFINED_I
3244     !</keyword>
3245     
3246     !<keyword category="UDF Control" required="false">
3247     !  <description>Udf Hook: Type of user-defined output: Binary of ASCII.</description>
3248     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3249              USR_TYPE(LC) = UNDEFINED_C
3250     !</keyword>
3251     
3252     !<keyword category="UDF Control" required="false">
3253     !  <description>Udf Hook:
3254     !    Variables to be written in the user-defined output files.
3255     !  </description>
3256     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3257              USR_VAR(LC) = UNDEFINED_C
3258     !</keyword>
3259     
3260     !<keyword category="UDF Control" required="false">
3261     !  <description>Udf Hook:
3262     !    Format for writing user-defined (ASCII) output file.
3263     !  </description>
3264     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3265              USR_FORMAT(LC) = UNDEFINED_C
3266     !</keyword>
3267     
3268     !<keyword category="UDF Control" required="false">
3269     !  <description>Udf Hook: File extension for the user-defined output.</description>
3270     !  <arg index="1" id="USR" max="DIMENSION_USR" min="1"/>
3271              USR_EXT(LC) = UNDEFINED_C
3272     !</keyword>
3273           ENDDO
3274     
3275     
3276     !#####################################################################!
3277     !                        Chemical Reactions                           !
3278     !#####################################################################!
3279     
3280     
3281     !<keyword category="Chemical Reactions" required="false">
3282     !  <description>Flag to use stiff chemistry solver (Direct Integration).</description>
3283     !  <conflict keyword="USE_RRATES" value=".TRUE."/>
3284           STIFF_CHEMISTRY = .FALSE.
3285     !</keyword>
3286     
3287     !<keyword category="Chemical Reactions" required="false">
3288     !  <description>
3289     !    Maximum number of internal steps ODEPACK may use to integrate
3290     !    over the time interval. Leaving this value unspecified permits
3291     !    an unlimited number of steps. The stiff solver reports the
3292     !    number of cells that exceed the number of steps as 'incomplete'.
3293     !  </description>
3294     !  <dependent keyword="STIFF_CHEMISTRY" value=".TRUE."/>
3295     !  <conflict keyword="USE_RRATES" value=".TRUE."/>
3296           STIFF_CHEM_MAX_STEPS = UNDEFINED_I
3297     !</keyword>
3298     
3299     !<keyword category="Chemical Reactions" required="false">
3300     !  <description>Flag to use legacy chemical reaction UDFs.</description>
3301           USE_RRATES = .FALSE.
3302     !</keyword>
3303     
3304     !<keyword category="Chemical Reactions" required="false" legacy=.TRUE.>
3305     !  <description>
3306     !    Names of gas and solids phase species as it appears in the
3307     !    materials database. The first NMAX(0) are the names of gas
3308     !    species. The next NMAX(1) are the names of solids phase-1
3309     !    species, etc.
3310     !  </description>
3311     !  <dependent keyword="USE_RRATES" value=".TRUE."/>
3312           SPECIES_NAME(:DIM_N_ALL) = UNDEFINED_C
3313     !</keyword>
3314     
3315     !<keyword category="Chemical Reactions" required="false">
3316     !  <description>
3317     !    Number of species in phase m. Note that the gas phase is indicated
3318     !    as m=0.
3319     !  </description>
3320     !  <dependent keyword="USE_RRATES" value=".TRUE."/>
3321           NMAX = UNDEFINED_I
3322     !</keyword>
3323     
3324     
3325     !#####################################################################!
3326     !                    Parallelization Control                          !
3327     !#####################################################################!
3328     
3329     
3330     !<keyword category="Parallelization Control" required="false">
3331     !  <description>Number of grid blocks in x-direction.</description>
3332           NODESI = UNDEFINED_I
3333     !</keyword>
3334     
3335     !<keyword category="Parallelization Control" required="false">
3336     !  <description>Number of grid blocks in y-direction.</description>
3337           NODESJ = UNDEFINED_I
3338     !</keyword>
3339     
3340     !<keyword category="Parallelization Control" required="false">
3341     !  <description>Number of grid blocks in z-direction.</description>
3342           NODESK = UNDEFINED_I
3343     !</keyword>
3344     
3345     !<keyword category="Parallelization Control" required="false">
3346     !  <description>Print out additional statistics for parallel runs</description>
3347           solver_statistics = .FALSE.
3348     !</keyword>
3349     
3350     !<keyword category="Parallelization Control" required="false">
3351     !  <description>Group residuals to reduce global collectives.</description>
3352           DEBUG_RESID = .TRUE.
3353     !</keyword>
3354     
3355     !<keyword category="Parallelization Control" required="false">
3356     !  <description>All ranks write error messages.</description>
3357           ENABLE_DMP_LOG = .FALSE.
3358     !</keyword>
3359     
3360     !<keyword category="Parallelization Control" required="false">
3361     !  <description>Print the index layout for debugging.</description>
3362           DBGPRN_LAYOUT = .FALSE.
3363     !</keyword>
3364     
3365     
3366     !#####################################################################!
3367     !                       Batch Queue Environment                       !
3368     !#####################################################################!
3369     
3370     
3371     !<keyword category="Batch Queue Environment" required="false">
3372     !  <description>
3373     !    Enables controlled termination feature when running under batch
3374     !    queue system to force MFIX to cleanly terminate before the end
3375     !    of wall clock allocated in the batch session.
3376     !  </description>
3377           CHK_BATCHQ_END = .FALSE.
3378     !</keyword>
3379     
3380     !<keyword category="Batch Queue Environment" required="false">
3381     !  <description>Total wall-clock duration of the job, in seconds.</description>
3382           BATCH_WALLCLOCK = 9000.0    ! set to 2.5 hrs for jaguarcnl w/ nproc<=512
3383     !</keyword>
3384     
3385     !<keyword category="Batch Queue Environment" required="false">
3386     !  <description>
3387     !    Buffer time specified to allow MFIX to write out the files and
3388     !    cleanly terminate before queue wall clock time limit is reached
3389     !    such that (BATCH_WALLCLOCK-TERM_BUFFER) is less than then batch
3390     !    queue wall clock time limit, in seconds.
3391     !  </description>
3392           TERM_BUFFER = 180.0         ! set to 3 minutes prior to end of job
3393     !</keyword>
3394     
3395     
3396     
3397     !#####################################################################!
3398     !          Direct Quadrature Method of Moments (DQMOM)                !
3399     !#####################################################################!
3400     
3401     
3402     !<keyword category="Direct Quadrature Method of Moments (DQMOM)" required="false">
3403     !  <description>Variable to decide if the population balance equations are solved.</description>
3404           Call_DQMOM = .FALSE.
3405     !</keyword>
3406     
3407     !<keyword category="Direct Quadrature Method of Moments (DQMOM)" required="false">
3408     !  <description>Success-factor for aggregation.</description>
3409           AGGREGATION_EFF=0.D0
3410     !</keyword>
3411     
3412     !<keyword category="Direct Quadrature Method of Moments (DQMOM)" required="false">
3413     !  <description>Success-factor for breakage.</description>
3414           BREAKAGE_EFF=0.D0
3415     !</keyword>
3416     
3417     
3418     
3419     
3420     
3421     
3422     
3423     
3424     ! ---------------------------------- questionable namelist entries below
3425     
3426     
3427     
3428     
3429     
3430     
3431     
3432     
3433     !<keyword category="category name" required="false">
3434     !  <description>Variable which triggers an automatic restart.</description>
3435           AUTOMATIC_RESTART = .FALSE.
3436     !</keyword>
3437     
3438     !<keyword category="category name" required="false">
3439     !  <description>AUTO_RESTART counter.</description>
3440           ITER_RESTART = 1
3441     !</keyword>
3442     
3443     
3444     
3445     ! NO_OF_RXNS is not a keyword. However, it is initialized here so that
3446     ! if there are no reactions, this value is assigned.
3447           NO_OF_RXNS = UNDEFINED_I
3448     
3449     
3450           U_G0 = UNDEFINED
3451           V_G0 = UNDEFINED
3452           W_G0 = UNDEFINED
3453           U_S0(:DIM_M) = UNDEFINED
3454           V_S0(:DIM_M) = UNDEFINED
3455           W_S0(:DIM_M) = UNDEFINED
3456     
3457     
3458           PHIP_OUT_ITER=0
3459     
3460     
3461     
3462     
3463     
3464           CALL DES_INIT_NAMELIST
3465     
3466           CALL QMOMK_INIT_NAMELIST
3467     
3468           CALL USR_INIT_NAMELIST
3469     
3470           CALL CARTESIAN_GRID_INIT_NAMELIST
3471     
3472           RETURN
3473           END SUBROUTINE INIT_NAMELIST
3474