File: N:\mfix\model\usr_properties.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: USR_PROP_ROg                                            !
4     !  Purpose: User hook for calculating the gas phase density.           !
5     !                                                                      !
6     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
7           SUBROUTINE USR_PROP_ROg(IJK)
8     
9     ! Modules
10     !---------------------------------------------------------------------//
11           use error_manager, only: init_err_msg, err_msg, flush_err_msg
12           use fldvar, only: t_g, x_g, p_g, ro_g
13           use param1, only: undefined_i, zero, one, half
14           use physprop, only: mw_g, mw_avg, nmax
15           use run, only: units
16           implicit none
17     
18     ! Dummy arguments
19     !---------------------------------------------------------------------//
20     ! index
21           INTEGER, INTENT(IN) :: IJK
22     
23     ! Local Variables:
24     !---------------------------------------------------------------------//
25     ! error flag
26           INTEGER :: IER = undefined_i
27           CHARACTER(LEN=40) :: err_prop
28     !......................................................................!
29     ! if using this quantity then remove definition of ier
30           ier = 1
31     
32     ! Assign the fluid density
33           RO_G(IJK) = ZERO
34     
35           IF (IER /= UNDEFINED_I) THEN
36              write(err_prop, '("gas density")')
37              CALL INIT_ERR_MSG('USR_PROP_ROg')
38              WRITE(ERR_MSG,9999) trim(err_prop)
39              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
40      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
41              'invoked for',/,A,' but this generic error',/,'message exi',&
42              'sts. Either choose a different model or correct',/,'mfix/,'&
43              'model/usr_properties.f')
44           ENDIF
45           RETURN
46           END SUBROUTINE USR_PROP_ROg
47     
48     
49     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
50     !                                                                      !
51     !  Subroutine: USR_PROP_CPg                                            !
52     !  Purpose: User hook for calculating the gas phase constant pressure  !
53     !  specific heat.                                                      !
54     !                                                                      !
55     !  Comments:                                                           !
56     !  - The specific heat assigned in this routine only applies to the    !
57     !    mixture average specific heat invoked in the general energy       !
58     !    equations. MFIX has no global variable representing species       !
59     !    specific heats. The reason for this limitation is explained.      !
60     !                                                                      !
61     !    Species specific heat values are locally evaluated based on a     !
62     !    specific polynominal format set by the Burcat database. Values    !
63     !    for the polynominal coefficients are read from either the         !
64     !    database or the mfix.dat. Species specific heats are needed by    !
65     !    reacting flow simulations.                                        !
66     !                                                                      !
67     !    Inconsistencies may arise in reacting flow systems if a user      !
68     !    specifies a phase average specific heat that is not consistent    !
69     !    with the values of the species specific heats that comprise that  !
70     !    phase.                                                            !
71     !    - IT may be possible to circumvent the matter long as the formula !
72     !      for the specific heat follows the burcat database form and      !
73     !      the quantites Thigh(M,N), Tlow(M,N), Tcom, Alow(M,N) and        !
74     !      Ahigh(M,N) are all appropriately assigned. However, the same    !
75     !      can be achieved by simply entering the data into the mfix.dat   !
76     !      as indicated by the user guide.                                 !
77     !    - To permit different forms of the polynominal for species        !
78     !      specific heats would require more code development to ensure    !
79     !      reacting flow simulations evaluate/reference the species        !
80     !      specific heats accordingly.                                     !
81     !                                                                      !
82     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
83           SUBROUTINE USR_PROP_CPg(IJK)
84     
85     ! Modules
86     !---------------------------------------------------------------------//
87           use error_manager, only: init_err_msg, err_msg, flush_err_msg
88           use constant, only: RGAS => GAS_CONST_cal
89           use fldvar, only: t_g, x_g
90           use param1, only: undefined_i, zero, one, half
91           use physprop, only: mw_g, c_pg, nmax
92           use read_thermochemical, only: calc_CpoR
93           use run, only: units
94           implicit none
95     
96     ! Dummy arguments
97     !---------------------------------------------------------------------//
98     ! index
99           INTEGER, INTENT(IN) :: IJK
100     
101     ! Local Variables:
102     !---------------------------------------------------------------------//
103     ! error flag
104           INTEGER :: IER = undefined_i
105           CHARACTER(LEN=40) :: err_prop
106     !......................................................................!
107     ! if using this quantity then remove definition of ier
108           ier = 1
109     
110     ! Assign the fluid specific heat
111           C_PG(IJK) = ZERO
112     
113           IF (IER /= UNDEFINED_I) THEN
114              write(err_prop, '("gas specific heat")')
115              CALL INIT_ERR_MSG('USR_PROP_CPg')
116              WRITE(ERR_MSG,9999) trim(err_prop)
117              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
118      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
119              'invoked for',/,A,' but this generic error',/,'message exi',&
120              'sts. Either choose a different model or correct',/,'mfix/,'&
121              'model/usr_properties.f')
122           ENDIF
123           RETURN
124           END SUBROUTINE USR_PROP_CPg
125     
126     
127     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
128     !                                                                      !
129     !  Subroutine: USR_PROP_Mug                                            !
130     !  Purpose: User hook for calculating the gas phase viscosity.         !
131     !                                                                      !
132     !  Comments:                                                           !
133     !  - Assign a value to gas phase viscosity (mu_g). MFIX uses the       !
134     !    concept of second viscosity (lambda_g) for its internal           !
135     !    calculations of stress. Second viscosity is defined as follows:   !
136     !       lambda_g = mu_gbulk - 2/3mu_g                                  !
137     !       where mu_gbulk is the gas phase bulk viscosity.                !
138     !    MFIX automatically calculates a value for the gas phase second    !
139     !    viscosity by assuming the gas phase bulk viscosity is zero. As a  !
140     !    result, gas phase second  viscosity is evaluated as follows:      !
141     !       lambda_g = -2/3mu_g                                            !
142     !                                                                      !
143     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
144           SUBROUTINE USR_PROP_Mug(IJK)
145     
146     ! Modules
147     !---------------------------------------------------------------------//
148           use constant, only: to_si
149           use error_manager, only: init_err_msg, err_msg, flush_err_msg
150           use fldvar, only: t_g, x_g, p_g, ro_g
151           use param1, only: undefined_i, zero, one, half
152           use physprop, only: mu_g, mw_g, mw_avg, nmax
153           use run, only: units
154           implicit none
155     
156     ! Dummy arguments
157     !---------------------------------------------------------------------//
158     ! index
159           INTEGER, INTENT(IN) :: IJK
160     
161     ! Local Variables:
162     !---------------------------------------------------------------------//
163     ! error flag
164           INTEGER :: IER = undefined_i
165           CHARACTER(LEN=40) :: err_prop
166     !......................................................................!
167     ! if using this quantity then remove definition of ier
168           ier = 1
169     
170     ! Assign the fluid viscosity
171           Mu_g(IJK) = ZERO
172     
173           IF (IER /= UNDEFINED_I) THEN
174              write(err_prop, '("gas viscosity")')
175              CALL INIT_ERR_MSG('USR_PROP_MUG')
176              WRITE(ERR_MSG,9999) trim(err_prop)
177              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
178      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
179              'invoked for',/,A,' but this generic error',/,'message exi',&
180              'sts. Either choose a different model or correct',/,'mfix/,'&
181              'model/usr_properties.f')
182           ENDIF
183           RETURN
184           END SUBROUTINE USR_PROP_Mug
185     
186     
187     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
188     !                                                                      !
189     !  Subroutine: USR_PROP_Kg                                             !
190     !  Purpose: User hook for calculating the gas phase conductivity.      !
191     !                                                                      !
192     !                                                                      !
193     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
194           SUBROUTINE USR_PROP_Kg(IJK)
195     
196     ! Modules
197     !---------------------------------------------------------------------//
198           use error_manager, only: init_err_msg, err_msg, flush_err_msg
199           use fldvar, only: t_g, x_g, p_g, ro_g
200           use param1, only: undefined_i, zero, one, half
201           use physprop, only: k_g, mw_g, mw_avg, nmax
202           use run, only: units
203           implicit none
204     
205     ! Dummy arguments
206     !---------------------------------------------------------------------//
207     ! index
208           INTEGER, INTENT(IN) :: IJK
209     
210     ! Local Variables:
211     !---------------------------------------------------------------------//
212     ! error flag
213           INTEGER :: IER = undefined_i
214           CHARACTER(LEN=40) :: err_prop
215     !......................................................................!
216     ! if using this quantity then remove definition of ier
217           ier = 1
218     
219     ! Assign the fluid conductivity
220           K_g(IJK) = ZERO
221     
222           IF (IER /= UNDEFINED_I) THEN
223              write(err_prop, '("gas conductivity")')
224              CALL INIT_ERR_MSG('USR_PROP_KG')
225              WRITE(ERR_MSG,9999) trim(err_prop)
226              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
227      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
228              'invoked for',/,A,' but this generic error',/,'message exi',&
229              'sts. Either choose a different model or correct',/,'mfix/,'&
230              'model/usr_properties.f')
231           ENDIF
232           RETURN
233           END SUBROUTINE USR_PROP_Kg
234     
235     
236     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
237     !                                                                      !
238     !  Subroutine: USR_PROP_Difg                                           !
239     !  Purpose: User hook for calculating the diffusivity of the gas phase !
240     !  species.                                                            !
241     !                                                                      !
242     !                                                                      !
243     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
244           SUBROUTINE USR_PROP_Difg(IJK,N)
245     
246     ! Modules
247     !---------------------------------------------------------------------//
248           use error_manager, only: init_err_msg, err_msg, flush_err_msg
249           use fldvar, only: t_g, x_g, p_g, ro_g, rop_g
250           use param1, only: undefined_i, zero, one, half
251           use physprop, only: dif_g, mw_g, mw_avg, nmax
252           use run, only: units
253           use scales, only: unscale_pressure
254           use toleranc, only: zero_x_gs
255           implicit none
256     
257     ! Dummy arguments
258     !---------------------------------------------------------------------//
259     ! index
260           INTEGER, INTENT(IN) :: IJK
261     ! species index
262           INTEGER, INTENT(IN) :: N
263     
264     ! Local Variables:
265     !---------------------------------------------------------------------//
266     ! error flag
267           INTEGER :: IER = undefined_i
268           CHARACTER(LEN=40) :: err_prop
269     !......................................................................!
270     ! if using this quantity then remove definition of ier
271           ier = 1
272     
273     ! Assign the fluid phase species diffusivity
274           Dif_g(IJK,N) = ZERO
275     
276           IF (IER /= UNDEFINED_I) THEN
277              write(err_prop, '("gas phase species ",I2," diffusivity")') N
278              CALL INIT_ERR_MSG('USR_PROP_DIFG')
279              WRITE(ERR_MSG,9999) trim(err_prop)
280              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
281      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
282              'invoked for',/,A,' but this generic error',/,'message exi',&
283              'sts. Either choose a different model or correct',/,'mfix/,'&
284              'model/usr_properties.f')
285           ENDIF
286           RETURN
287           END SUBROUTINE USR_PROP_Difg
288     
289     
290     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
291     !                                                                      !
292     !  Subroutine: USR_PROP_ROs                                            !
293     !  Purpose: User hook for calculating solids phase density.            !
294     !                                                                      !
295     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
296           SUBROUTINE USR_PROP_ROs(IJK,M)
297     
298     ! Modules
299     !---------------------------------------------------------------------//
300           use error_manager, only: init_err_msg, err_msg, flush_err_msg
301           use fldvar, only: ro_s, T_s, X_s
302           use param1, only: undefined_i, zero, one, half
303           use physprop, only: mw_s, nmax
304           use run, only: units
305           implicit none
306     
307     ! Dummy arguments
308     !---------------------------------------------------------------------//
309     ! index
310           INTEGER, INTENT(IN) :: IJK
311     ! solids phase index
312           INTEGER, INTENT(IN) :: M
313     
314     ! Local Variables:
315     !---------------------------------------------------------------------//
316     ! error flag
317           INTEGER :: IER = undefined_i
318           CHARACTER(LEN=40) :: err_prop
319     !......................................................................!
320     ! if using this quantity then remove definition of ier
321           ier = 1
322     
323     ! Assign the solids phase density
324           RO_S(IJK,M) = ZERO
325     
326           IF (IER /= UNDEFINED_I) THEN
327              write(err_prop, '("solids phase ",I2," density")') M
328              CALL INIT_ERR_MSG('USR_PROP_ROS')
329              WRITE(ERR_MSG,9999) trim(err_prop)
330              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
331      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
332              'invoked for',/,A,' but this generic error',/,'message exi',&
333              'sts. Either choose a different model or correct',/,'mfix/,'&
334              'model/usr_properties.f')
335           ENDIF
336           RETURN
337           END SUBROUTINE USR_PROP_ROs
338     
339     
340     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
341     !                                                                      !
342     !  Subroutine: USR_PROP_CPs                                            !
343     !  Purpose: User hook for calculating solids phase constant pressure   !
344     !  specific heat.                                                      !
345     !                                                                      !
346     !  Comments:                                                           !
347     !  - See comments under USER_PROP_CPg                                  !
348     !                                                                      !
349     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
350           SUBROUTINE USR_PROP_CPs(IJK, M)
351     ! Modules
352     !---------------------------------------------------------------------//
353           use error_manager, only: init_err_msg, err_msg, flush_err_msg
354           use constant, only: RGAS => GAS_CONST_cal
355           use fldvar, only: t_s, x_s
356           use param1, only: undefined_i, zero, one, half
357           use physprop, only: mw_s, c_ps, nmax
358           use read_thermochemical, only: calc_CpoR
359           use run, only: units
360           implicit none
361     
362     ! Dummy arguments
363     !---------------------------------------------------------------------//
364     ! index
365           INTEGER, INTENT(IN) :: IJK
366     ! solids phase index
367           INTEGER, INTENT(IN) :: M
368     
369     ! Local Variables:
370     !---------------------------------------------------------------------//
371     ! error flag
372           INTEGER :: IER = undefined_i
373           CHARACTER(LEN=40) :: err_prop
374     !......................................................................!
375     ! if using this quantity then remove definition of ier
376           ier = 1
377     
378     ! Assign the solids phase specific heat
379           C_PS(IJK,M) = ZERO
380     
381           IF (IER /= UNDEFINED_I) THEN
382              write(err_prop, '("solids phase ",I2," specific heat")') M
383              CALL INIT_ERR_MSG('USR_PROP_CPs')
384              WRITE(ERR_MSG,9999) trim(err_prop)
385              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
386      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
387              'invoked for',/,A,' but this generic error',/,'message exi',&
388              'sts. Either choose a different model or correct',/,'mfix/,'&
389              'model/usr_properties.f')
390           ENDIF
391           RETURN
392           END SUBROUTINE USR_PROP_CPs
393     
394     
395     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
396     !                                                                      !
397     !  Subroutine: USR_PROP_Mus                                            !
398     !  Purpose: User hook for calculating the solids phase viscosity.      !
399     !                                                                      !
400     !  Comments:                                                           !
401     !  - Assign a value to solids phase viscosity (mu_g), second viscosity !
402     !    (lambda_s) and solids pressure (p_s). MFIX uses the concept of    !
403     !    second viscosity for its internal calculations of stress. Second  !
404     !    viscosity is defined as follows:                                  !
405     !       lambda_s = mu_sbulk - 2/3 mu_s                                 !
406     !       where mu_sbulk is the solids phase bulk viscosity.             !
407     !                                                                      !
408     !  - In assigning a value to solids pressure consider how MFIX's       !
409     !    governing equations have been posed and what physics at are       !
410     !    involved. Nominally the governing equations are written assuming  !
411     !    a gas-solids system wherein the gradient in gas phase pressure    !
412     !    is present in the solids phase momentum balances.                 !
413     !                                                                      !
414     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
415           SUBROUTINE USR_PROP_Mus(IJK,M)
416     
417     ! Modules
418     !---------------------------------------------------------------------//
419           use constant, only: to_si
420           use error_manager, only: init_err_msg, err_msg, flush_err_msg
421           use fldvar, only: t_s, x_s, rop_s, ro_s, ep_s, p_s
422           use param1, only: undefined_i, zero, one, half
423           use physprop, only: mw_s, nmax
424           use run, only: units
425           use visc_s, only: mu_s, lambda_s
426           implicit none
427     
428     ! Dummy arguments
429     !---------------------------------------------------------------------//
430     ! index
431           INTEGER, INTENT(IN) :: IJK
432     ! solids phase index
433           INTEGER, INTENT(IN) :: M
434     
435     ! Local Variables:
436     !---------------------------------------------------------------------//
437     ! error flag
438           INTEGER :: IER = undefined_i
439           CHARACTER(LEN=40) :: err_prop
440     !......................................................................!
441     ! if using this quantity then remove definition of ier
442           ier = 1
443     
444     ! Assign the solids phase viscosity, second viscosity and pressure
445           Mu_s(IJK,M) = ZERO
446           LAMBDA_S(IJK,M) = ZERO
447           P_S(IJK,M) = ZERO
448     
449           IF (IER /= UNDEFINED_I) THEN
450              write(err_prop, '("solids phase ",I2," viscosity")') M
451              CALL INIT_ERR_MSG('USR_PROP_Mus')
452              WRITE(ERR_MSG,9999) trim(err_prop)
453              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
454      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
455              'invoked for',/,A,' but this generic error',/,'message exi',&
456              'sts. Either choose a different model or correct',/,'mfix/,'&
457              'model/usr_properties.f')
458           ENDIF
459           RETURN
460           END SUBROUTINE USR_PROP_Mus
461     
462     
463     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
464     !                                                                      !
465     !  Subroutine: USR_PROP_Ks                                             !
466     !  Purpose: User hook for calculating solids phase conductivity.       !
467     !                                                                      !
468     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
469           SUBROUTINE USR_PROP_Ks(IJK,M)
470     
471     ! Modules
472     !---------------------------------------------------------------------//
473           use error_manager, only: init_err_msg, err_msg, flush_err_msg
474           use fldvar, only: ro_s, T_s, X_s, ep_s, ep_g, rop_s
475           use param1, only: undefined_i, zero, one, half
476           use physprop, only: mw_s, nmax, k_s, k_g
477           use run, only: units
478           use toleranc, only: dil_ep_s
479           implicit none
480     
481     ! Dummy arguments
482     !---------------------------------------------------------------------//
483     ! index
484           INTEGER, INTENT(IN) :: IJK
485     ! solids phase index
486           INTEGER, INTENT(IN) :: M
487     
488     ! Local Variables:
489     !---------------------------------------------------------------------//
490     ! error flag
491           INTEGER :: IER = undefined_i
492           CHARACTER(LEN=40) :: err_prop
493     !......................................................................!
494     ! if using this quantity then remove definition of ier
495           ier = 1
496     
497     ! Assign the solids phase conductivity
498           K_S(IJK,M) = ZERO
499     
500           IF (IER /= UNDEFINED_I) THEN
501              write(err_prop, '("solids phase ",I2," conductivity")') M
502              CALL INIT_ERR_MSG('USR_PROP_KS')
503              WRITE(ERR_MSG,9999) trim(err_prop)
504              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
505      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
506              'invoked for',/,A,' but this generic error',/,'message exi',&
507              'sts. Either choose a different model or correct',/,'mfix/,'&
508              'model/usr_properties.f')
509           ENDIF
510           RETURN
511           END SUBROUTINE USR_PROP_Ks
512     
513     
514     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
515     !                                                                      !
516     !  Subroutine: USR_PROP_Difs                                           !
517     !  Purpose: User hook for calculating diffusivity of 'solids' phase    !
518     !  species.                                                            !
519     !                                                                      !
520     !  Comments:                                                           !
521     !  - As always consider whether such a term is meaningful in the       !
522     !    system being modeled.                                             !
523     !                                                                      !
524     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
525           SUBROUTINE USR_PROP_Difs(IJK,M,N)
526     
527     ! Modules
528     !---------------------------------------------------------------------//
529           use error_manager, only: init_err_msg, err_msg, flush_err_msg
530           use fldvar, only: ro_s, T_s, X_s, ep_s, ep_g, rop_s
531           use param1, only: undefined_i, zero, one, half
532           use physprop, only: mw_s, nmax, dif_s
533           use run, only: units
534           implicit none
535     
536     ! Dummy arguments
537     !---------------------------------------------------------------------//
538     ! index
539           INTEGER, INTENT(IN) :: IJK
540     ! solids phase index
541           INTEGER, INTENT(IN) :: M
542     ! species index
543           INTEGER, INTENT(IN) :: N
544     
545     ! Local Variables:
546     !---------------------------------------------------------------------//
547     ! error flag
548           INTEGER :: IER = undefined_i
549           CHARACTER(LEN=40) :: err_prop
550     !......................................................................!
551     ! if using this quantity then remove definition of ier
552           ier = 1
553     
554     ! Assign the solids phase species diffusivity
555           DIF_S(IJK,M,N) = ZERO
556     
557           IF (IER /= UNDEFINED_I) THEN
558              write(err_prop, '("solids phase ",I2," species ", I2, &
559                                " diffusivity")') M, N
560              CALL INIT_ERR_MSG('USR_PROP_DIFS')
561              WRITE(ERR_MSG,9999) trim(err_prop)
562              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
563      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
564              'invoked for',/,A,' but this generic error',/,'message exi',&
565              'sts. Either choose a different model or correct',/,'mfix/,'&
566              'model/usr_properties.f')
567           ENDIF
568           RETURN
569           END SUBROUTINE USR_PROP_Difs
570     
571     
572     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
573     !                                                                      !
574     !  Subroutine: USR_PROP_Gama                                           !
575     !  Purpose: User hook for calculating the gas-solids heat transfer     !
576     !  coefficient due to relative temperature differences between the     !
577     !  gas phase (M=0) and each 'solids' phase (M=1 to MMAX)               !
578     !                                                                      !
579     !  Comments:                                                           !
580     !  - No solids-solids heat transfer is allowed at this time. To        !
581     !    account for this term would require appropriate closure and       !
582     !    additional code development.                                      !
583     !                                                                      !
584     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
585           SUBROUTINE USR_PROP_Gama(IJK,M)
586     
587     ! Modules
588     !---------------------------------------------------------------------//
589           use error_manager, only: init_err_msg, err_msg, flush_err_msg
590           use energy, only: gama_gs
591           use fldvar, only: u_g, v_g, w_g, u_s, v_s, w_s
592           use fldvar, only: ep_s, ep_g, rop_s, rop_g, ro_s, ro_g
593           use fldvar, only: T_s, T_g, d_p
594           Use fun_avg, only: avg_x_e, avg_y_n, avg_z_t
595           use functions, only: im_of, jm_of, km_of
596           use indices, only: i_of
597           use param1, only: undefined_i, zero, one, half
598           use param1, only: small_number, large_number
599           use physprop, only: mu_g, k_g, c_pg
600           use run, only: units
601           use rxns, only: r_phase
602           implicit none
603     
604     ! Dummy arguments
605     !---------------------------------------------------------------------//
606     ! index
607           INTEGER, INTENT(IN) :: IJK
608     ! solids phase index
609           INTEGER, INTENT(IN) :: M
610     
611     ! Local Variables:
612     !---------------------------------------------------------------------//
613     ! error flag
614           INTEGER :: IER = undefined_i
615           CHARACTER(LEN=50) :: err_prop
616     !......................................................................!
617     ! if using this quantity then remove definition of ier
618           ier = 1
619     
620     ! Assign the gas-solids phase heat transfer coefficient
621           GAMA_GS(IJK,M) = ZERO
622     
623           IF (IER /= UNDEFINED_I) THEN
624              write(err_prop, '("gas-solids phase ",I2," heat transfer ", &
625                                "coefficient")') M
626              CALL INIT_ERR_MSG('USR_PROP_Gama')
627              WRITE(ERR_MSG,9999) trim(err_prop)
628              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
629      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
630              'invoked for',/,A,' but this generic error',/,'message exi',&
631              'sts. Either choose a different model or correct',/,'mfix/,'&
632              'model/usr_properties.f')
633           ENDIF
634           RETURN
635           END SUBROUTINE USR_PROP_GAMA
636     
637     
638     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
639     !                                                                      !
640     !  Subroutine: USR_PROP_FSS                                            !
641     !  Purpose: User hook for calculating the solids-solids drag           !
642     !  coefficient due to relative velocity differences between each of    !
643     !  solids phases (M = 1 to MMAX).                                      !
644     !                                                                      !
645     !  Comments:                                                           !
646     !  - solids-solids drag is momentum transfer due to relative velocity  !
647     !    differences between solids phases M and L, where M and L range    !
648     !    from 1 to MMAX and M!=L.                                          !
649     !  - this implementation is currently restricted to solids-solids      !
650     !    drag between continuum solids phases. Further development is      !
651     !    needed to interact with discrete phases.                          !
652     !                                                                      !
653     !                                                                      !
654     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
655           SUBROUTINE USR_PROP_Fss(IJK,L,M)
656     
657     ! Modules
658     !---------------------------------------------------------------------//
659           use constant, only: segregation_slope_coefficient
660           use drag, only: f_ss
661           use error_manager, only: init_err_msg, err_msg, flush_err_msg
662           use fldvar, only: u_s, v_s, w_s
663           use fldvar, only: ep_s, ep_g, rop_s, ro_s
664           use fldvar, only: d_p, p_star
665           use fun_avg, only: avg_x_e, avg_y_n, avg_z_t
666           use functions, only: funlm
667           use functions, only: im_of, jm_of, km_of
668           use indices, only: i_of
669           use param1, only: undefined_i, zero, one, half
670           use param1, only: small_number, large_number
671           use physprop, only: smax, close_packed
672           use run, only: units
673           use rdf, only: g_0
674           implicit none
675     
676     ! Dummy arguments
677     !---------------------------------------------------------------------//
678     ! index
679           INTEGER, INTENT(IN) :: IJK
680     ! solids phase indices
681           INTEGER, INTENT(IN) :: M, L
682     
683     ! Local Variables:
684     !---------------------------------------------------------------------//
685     ! index for storing solids-solids drag coefficients in the upper
686     ! triangle of the matrix
687           INTEGER :: LM
688     ! error flag
689           INTEGER :: IER = undefined_i
690           CHARACTER(LEN=60) :: err_prop
691     !......................................................................!
692     ! if using this quantity then remove definition of ier
693           ier = 1
694     
695     ! Assign the solids-solids drag coefficient
696           LM = FUNLM(L,M)
697           F_SS(IJK,LM) = ZERO
698     
699           IF (IER /= UNDEFINED_I) THEN
700              write(err_prop, '("solids phase ",I2," solids phase ", I2, &
701                                " drag coefficient")') M, L
702              CALL INIT_ERR_MSG('USR_PROP_FSS')
703              WRITE(ERR_MSG,9999) trim(err_prop)
704              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
705      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
706              'invoked for',/,A,' but this generic error',/,'message exi',&
707              'sts. Either choose a different model or correct',/,'mfix/,'&
708              'model/usr_properties.f')
709           ENDIF
710           RETURN
711           END SUBROUTINE USR_PROP_FSS
712     
713     
714     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
715     !                                                                      C
716     !  Subroutine: USR_PROPERTIES                                          C
717     !  Purpose: Hook for user defined physical properties and transport    C
718     !  coefficients including interphase exchange coefficients for all     C
719     !  phases. The exact quantities are listed here for clarity.           C
720     !                                                                      C
721     !         Quantity      GAS (M=0)     SOLIDS (M=1toMMAX)               C
722     !         density       RO_G(:)        RO_S(:,M)                       C
723     !      specific heat    C_PG(:)        C_PS(:,M)                       C
724     !       conductivity    K_G(:)         K_S(:,M)                        C
725     !       diffusivity     DIF_G(:,N)     DIF_S(:,M,N)                    C
726     !        viscosity      MU_G(:)        MU_S(:,M)                       C
727     !     gas-solids drag                  F_GS(:,M)                       C
728     !   solids-solids drag                 F_SS(:,LM)                      C
729     !   gas-solids heat tr.                GAMA(:,M)                       C
730     !                                                                      C
731     !  Comments:                                                           C
732     !  - gas-solids drag is momentum transfer due to relative velocity     C
733     !    differences (skin friction and form drag) between the gas phase   C
734     !    (M=0) and each solids phase (M=1 to MMAX).                        C
735     !  - solids-solids drag is momentum transfer due to relative velocity  C
736     !    differences between solids phases M and L, where M and L range    C
737     !    from 1 to MMAX and M!=L.                                          C
738     !  - gas-solids heat transfer is heat transfer due to relative         C
739     !    temperature differences between the gas phase phase (M=0) and     C
740     !    each solids phase (M=1 to MMAX).                                  C
741     !  - No solids-solids heat transfer is allowed. To account for such    C
742     !    would require appropriate closures and additional code            C
743     !    development.                                                      C
744     !  - the specific heat assigned in this routine only applies to the    C
745     !    mixture average specific heat invoked in the general energy       C
746     !    equations. reacting flow simulations require values for species   C
747     !    specific heat and are taken from the Burcat database or read      C
748     !    in that format from the mfix.dat file. therefore inconsitencies   C
749     !    may arise in calculations involving species specific heat. this   C
750     !    requires further development to fully address.                    C
751     !                                                                      C
752     !                                                                      C
753     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
754           SUBROUTINE USR_PROPERTIES(lprop, IJK, M, N)
755     
756     ! Modules
757     !-----------------------------------------------
758           use constant, only: pi, gas_const, gravity
759           use error_manager
760     
761           use fldvar, only: u_g, v_g, w_g, ep_g
762           use fldvar, only: u_s, v_s, w_s, ep_s
763           use fldvar, only: p_g, rop_g, ro_g, T_g, X_g
764           use fldvar, only: p_s, rop_s, ro_s, T_s, X_s
765           use fldvar, only: d_p, theta_m
766     
767           use fldvar, only: scalar
768           use functions
769           use geometry
770     
771           use indices, only: i_of, j_of, k_of
772           use indices, only: im1, ip1, jm1, jp1, km1, kp1
773     
774           use param1, only: zero, one, half, undefined, undefined_i
775           use physprop, only: k_g, c_pg, dif_g, mu_g
776           use physprop, only: k_s, c_ps, dif_s
777           use scalars, only: phase4scalar
778           use visc_s, only: mu_s, lambda_s
779           use usr_prop
780           IMPLICIT NONE
781     
782     ! Dummy arguments
783     !-----------------------------------------------
784     ! reference equation
785           INTEGER, INTENT(IN) :: lprop
786     ! index
787           INTEGER, INTENT(IN) :: IJK
788     ! Phase index
789           INTEGER, INTENT(IN) :: M
790     ! Species index or second solids phase index for solids-solids drag
791     ! (if applicable otherwise undefined_i)
792           INTEGER, INTENT(IN) :: N
793     
794     ! Local variables
795     !-----------------------------------------------
796     ! Error flag
797           INTEGER :: IER
798           CHARACTER(len=40):: err_prop
799     
800     !-----------------------------------------------
801     ! initialize
802           ier = undefined_i
803     
804     ! in each case the ier flag is set to ensure that if a user defined
805     ! quantity is invoked that the associated user defined quantity is
806     ! actually specified. this flag must be removed by the user or the
807     ! code will fail.
808     
809           SELECT CASE(lprop)
810     
811     !
812           CASE (GAS_DENSITY)
813     ! if using this quantity then remove definition of ier
814              ier = 1
815              write(err_prop, '("gas density")')
816     !        RO_G(IJK) =
817     
818     
819           CASE (GAS_SPECIFICHEAT)
820     ! if using this quantity then remove definition of ier
821              ier = 1
822              write(err_prop, '("gas specific heat")')
823     !        C_PG(IJK,M) =
824     
825     
826     ! assign gas viscosity value mu_g. bulk viscosity is taken as zero.
827     ! second viscosity (lambda_g) is automatically defined as
828     ! lambda_g = -2/3mu_g
829           CASE (GAS_VISCOSITY)
830     ! if using this quantity then remove definition of ier
831              ier = 1
832              write(err_prop, '("gas viscosity")')
833     !        MU_G(IJK) =
834     
835     
836           CASE (GAS_CONDUCTIVITY)
837     ! if using this quantity then remove definition of ier
838              ier = 1
839              write(err_prop, '("gas conductivity")')
840     !        K_G(IJK) =
841     
842     
843           CASE (GAS_DIFFUSIVITY)
844     ! if using this quantity then remove definition of ier
845              ier = 1
846              write(err_prop, '("gas diffusivity")')
847     !        DIF_G(IJK,N) =
848     
849     
850           CASE (SOLIDS_DENSITY)
851     ! if using this quantity then remove definition of ier
852              ier = 1
853              write(err_prop, '("solids phase ",I2," density")') M
854     !        RO_S(IJK,M) =
855     
856     
857           CASE (SOLIDS_SPECIFICHEAT)
858     ! if using this quantity then remove definition of ier
859              ier = 1
860              write(err_prop, '("solids phase ",I2," specific heat")') M
861     !        C_PS(IJK,M) =
862     
863     
864     ! assign solids phase M viscosity mu_s.
865     ! assign second viscosity (lambda_s): lambda_s = mu_sbulk - 2/3mu_s
866     ! assign solids pressure p_s.
867           CASE (SOLIDS_VISCOSITY)
868     ! if using this quantity then remove definition of ier
869              ier = 1
870              write(err_prop, '("solids phase ", I2," viscosity")') M
871     !        MU_S(IJK,M) =
872     !        LAMBDA_S(IJK,M) =
873     !        P_S(IJK,M) =
874     
875     
876           CASE (SOLIDS_CONDUCTIVITY)
877     ! if using this quantity then remove definition of ier
878              ier = 1
879              write(err_prop, '("solids phase ",I2," conductivity")') M
880     !        K_S(IJK,M) =
881     
882     
883           CASE (SOLIDS_DIFFUSIVITY)
884     ! if using this quantity then remove definition of ier
885              ier = 1
886              write(err_prop, '("solids phase",I2," diffusivity")') M
887     !        DIF_S(IJK,M,N) =
888     
889     
890           CASE (GASSOLIDS_HEATTRANSFER)
891     ! if using this quantity then remove definition of ier
892              ier = 1
893              write(err_prop, &
894                    '("gas-solids phase ",I2," heat transfer coefficient")') M
895     !       GAMA_GS(IJK,M) =
896     
897     
898           CASE (GASSOLIDS_DRAG)
899     ! if using this quantity then remove definition of ier
900              ier = 1
901              write(err_prop, &
902                    '("gas-solids phase ",I2," drag coefficient")') M
903     !        F_GS(IJK,M) =
904     
905     
906           CASE (SOLIDSSOLIDS_DRAG)
907     ! if using this quantity then remove definition of ier
908              ier = 1
909              write(err_prop, &
910                 '("solids-solids phases ",I2," & ",I2," drag coefficient")') M, N
911     !        F_SS(IJK,LM) =
912     
913     
914           END SELECT
915     
916           IF (IER /= UNDEFINED_I) THEN
917              CALL INIT_ERR_MSG('USR_PROPERTIES')
918              WRITE(ERR_MSG,9999) trim(err_prop)
919              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
920     
921      9999 FORMAT('ERROR 9999: The user-defined properties routine was ',&
922              'invoked for',/,A,' but this generic error',/,'message exits.',&
923              'Either choose a different model or correct',/,'mfix/model/',&
924              'usr_properties.f')
925           ENDIF
926     
927           RETURN
928           END SUBROUTINE USR_PROPERTIES
929     
930