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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  MODULE: COEFF                                                       !
4     !  Purpose: Contains logic flags that tells the code whether to        !
5     !           perform the indicated type of calculation when the         !
6     !           value is true                                              !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           MODULE coeff
10     
11     ! Flags used by PHYSICAL_PROP :: (0:DIMENSION_M)
12     !```````````````````````````````````````````````````````````````````````
13           LOGICAL, ALLOCATABLE :: DENSITY(:)  ! Density
14           LOGICAL, ALLOCATABLE :: SP_HEAT(:)  ! Specific heat
15           LOGICAL, ALLOCATABLE :: PSIZE(:)    ! Particle diameter
16     
17     
18     ! Flags used by TRANSPORT_PROP :: (0:DIMENSION_M)
19     !```````````````````````````````````````````````````````````````````````
20           LOGICAL, ALLOCATABLE :: VISC(:)      ! Viscosity
21           LOGICAL, ALLOCATABLE :: COND(:)      ! Conductivity
22           LOGICAL, ALLOCATABLE :: DIFF(:)      ! Diffusivity
23           LOGICAL, ALLOCATABLE :: GRAN_DISS(:) ! Granular energy dissipation
24     
25     
26     ! Flags used by EXCHANGE :: (0:DIMENSION_M)x(0:DIMENSION_M)
27     !```````````````````````````````````````````````````````````````````````
28           LOGICAL, ALLOCATABLE :: DRAGCOEF(:,:) ! Drag coefficient
29           LOGICAL, ALLOCATABLE :: HEAT_TR(:,:)  ! Heat transfer coeff
30     
31     
32           contains
33     
34     !**********************************************************************!
35     !  SUBROUTINE: INIT_COEFF                                              !
36     !                                                                      !
37     !  Purpose: Initialize logical flags.                                  !
38     !                                                                      !
39     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
40           SUBROUTINE INIT_COEFF(IER)
41     
42     ! Global Variables:
43     !-----------------------------------------------------------------------
44           use param, only: DIMENSION_M
45           use param1, only: UNDEFINED
46     ! Kinetic theory model.
47           USE run, only: kt_type_enum
48           USE run, only: gd_1999, gtsh_2012, ia_2005, ghd_2007
49     ! Run-time flag for invoking DQMOM
50           use run, only: CALL_DQMOM
51     ! Real number of solids phases (GHD theory)
52           use physprop, only: SMAX
53     ! Run-time flag for to solve energy equations.
54           use run, only: ENERGY_EQ
55     ! Run-time flag for to solve species equations.
56           use run, only: SPECIES_EQ
57     ! Flag to recalculate gas viscosity.
58           use visc_g, only: RECALC_VISC_G
59     ! Run-time flag for invoking discrete element model
60           use discretelement, only: DISCRETE_ELEMENT
61     ! Run-time flag for gas/DEM coupling
62           use discretelement, only: DES_CONTINUUM_COUPLED
63     ! Run-time flag for invoking TFM/DEM hybrid model
64           use discretelement, only: DES_CONTINUUM_HYBRID
65     ! Run-time flag invoking QMOM theory
66           use qmom_kinetic_equation, only: QMOMK
67     ! Specified constant gas phase density (incompressible)
68           use physprop, only: RO_G0
69     ! Specified constant specific heat.
70           use physprop, only: C_PG0, C_PS0
71     ! Specified constant thermal conductivity.
72           use physprop, only: K_G0, K_S0
73     ! specified constant diffusivity
74           use physprop, only: DIF_G0, DIF_S0
75     ! Specified number of solids phases.
76           use physprop, only: MMAX
77     ! Specified constant viscosity.
78           use physprop, only: MU_g0
79     ! Variable solids density flag.
80           use run, only: SOLVE_ROs
81     ! MMS flag
82           use mms, only: USE_MMS
83     ! user defined flags
84           use usr_prop, only: usr_rog, usr_cpg, usr_kg, usr_mug, usr_difg
85           use usr_prop, only: usr_ros, usr_cps, usr_ks, usr_mus, usr_difs
86           use usr_prop, only: usr_gama, usr_fgs, usr_fss
87           implicit none
88     
89     ! Dummy Arguments:
90     !-----------------------------------------------------------------------
91     ! Error flag.
92           INTEGER, intent(inout) :: IER
93     
94     
95     ! Local Variables.
96     !-----------------------------------------------------------------------
97     ! Invoke debug routine:
98           LOGICAL, parameter :: dbg_coeffs = .FALSE.
99     ! Loop counter for solids phases
100           INTEGER :: M
101     
102     ! Allocate and initialize:
103     !```````````````````````````````````````````````````````````````````````
104           IF(.NOT.allocated(DENSITY)) allocate( DENSITY(0:DIMENSION_M))
105           IF(.NOT.allocated(SP_HEAT)) allocate( SP_HEAT(0:DIMENSION_M))
106           IF(.NOT.allocated(PSIZE)) allocate( PSIZE(0:DIMENSION_M))
107     ! Interphase heat transfer coefficient (GAMA)
108     
109           DENSITY = .FALSE.
110           SP_HEAT = .FALSE.
111           PSIZE   = .FALSE.
112     
113           IF(.NOT.allocated(VISC)) allocate( VISC(0:DIMENSION_M))
114           IF(.NOT.allocated(COND)) allocate( COND(0:DIMENSION_M))
115           IF(.NOT.allocated(DIFF)) allocate( DIFF(0:DIMENSION_M))
116           IF(.NOT.allocated(GRAN_DISS)) allocate( GRAN_DISS(0:DIMENSION_M))
117     
118           VISC = .FALSE.
119           COND = .FALSE.
120           DIFF = .FALSE.
121           GRAN_DISS = .FALSE.
122     
123           IF(.NOT.allocated(DRAGCOEF)) &
124              allocate( DRAGCOEF(0:DIMENSION_M,0:DIMENSION_M))
125           IF(.NOT.allocated(HEAT_TR)) &
126              allocate( HEAT_TR(0:DIMENSION_M,0:DIMENSION_M))
127     
128           DRAGCOEF = .FALSE.
129           HEAT_TR = .FALSE.
130     
131     ! Coefficients for gas phase parameters.
132     !```````````````````````````````````````````````````````````````````````
133     ! Compressible flow.
134           if(RO_G0 == UNDEFINED .OR. USR_ROg) DENSITY(0) = .TRUE.
135     
136     ! Gas viscosity:
137     ! Calc_mu_g must be invoked every iteration even if constant viscosity
138     ! (mu_g0 /= undefined) to incorporate ishii form of governing equations
139     ! wherein the viscosity is multiplied by the phase volume fraction.
140     ! Alternatively, we could invoke calc_mu_g only if energy, k_epsilon,
141     ! l_scale0 /= 0, or ishii (use recalc_visc_g)
142           VISC(0) = .TRUE.
143     
144     ! Specific heat and thermal conductivity.
145           if(ENERGY_EQ) then
146              if(C_PG0 == UNDEFINED .or. usr_cpg) SP_HEAT(0) = .TRUE.
147              if(K_G0  == UNDEFINED .or. usr_kg) COND(0) = .TRUE.
148           endif
149     
150     ! Species diffusivity.
151           if(SPECIES_EQ(0)) then
152             if (dif_g0 == undefined .or. usr_difg) DIFF(0) = .TRUE.
153           endif
154     
155     ! Interphase transfer terms.
156     !```````````````````````````````````````````````````````````````````````
157     ! this needs to be mmax for ghd
158            if(.NOT.QMOMK .AND. .NOT.USE_MMS) DRAGCOEF(0:MMAX,0:MMAX)=.TRUE.
159     
160     ! Interphase heat transfer coefficient (GAMA)
161           IF (.NOT.DISCRETE_ELEMENT .OR. DES_CONTINUUM_HYBRID) THEN
162              if(ENERGY_EQ .AND. .NOT.USE_MMS) HEAT_TR(0:SMAX,0:SMAX)=.TRUE.
163           ENDIF
164     
165     ! Coefficients for solids phase parameters.
166     !```````````````````````````````````````````````````````````````````````
167           IF (.NOT.DISCRETE_ELEMENT .OR. DES_CONTINUUM_HYBRID) THEN
168              DO M=1,SMAX
169     ! Variable solids density or user solids density
170                 if(SOLVE_ROs(M) .or. USR_ROs(M)) DENSITY(M) = .TRUE.
171              ENDDO
172     
173     ! Solids viscosity.
174     ! Calc_mu_s must be invoked every iteration even if constant viscosity
175     ! (mu_s0 /= undefined) to incorporate ishii form of governing equations
176     ! wherein the viscosity is multiplied by the phase volume fraction
177              VISC(1:SMAX) = .TRUE.
178     ! mu_s only needs to be called for ghd_2007 when m=mmax
179              IF (KT_TYPE_ENUM == GHD_2007) THEN
180                 VISC(1:SMAX) = .FALSE.
181                 VISC(MMAX) = .TRUE.
182              ENDIF
183     
184              do M=1,SMAX
185     ! Specific heat and thermal conductivity.
186                 if(ENERGY_EQ) THEN
187                    if(C_PS0(M) == UNDEFINED .or. usr_cps(M)) SP_HEAT(M) = .TRUE.
188                    if(K_S0(M)  == UNDEFINED .or. usr_ks(M)) COND(M) = .TRUE.
189                 endif
190     ! Species diffusivity. Generally no need to invoke this routine since
191     ! by default solids diffusivisty is zero, however, now it is invoked
192     ! for user options
193                 IF(SPECIES_EQ(M)) THEN
194                    IF (DIF_S0(M) == UNDEFINED .or. usr_difs(M)) DIFF(M) = .TRUE.
195                 ENDIF
196              enddo
197     
198     ! Particle-Particle Energy Dissipation
199              IF (KT_TYPE_ENUM == IA_2005 .OR. &
200                  KT_TYPE_ENUM == GD_1999 .OR. &
201                  KT_TYPE_ENUM == GTSH_2012) THEN
202                 GRAN_DISS(:SMAX) = .TRUE.
203              ENDIF
204     
205     ! Particle diameter.
206              if(Call_DQMOM) PSIZE(1:SMAX)=.TRUE.
207     
208           ENDIF   ! end if (.not.discrete_element .or des_continuum_hybrid)
209     
210           if(dbg_coeffs) CALL DEBUG_COEFF
211     
212     ! Invoke calc_coeff.
213           IF(.NOT.DISCRETE_ELEMENT .OR. DES_CONTINUUM_COUPLED) THEN
214              CALL CALC_COEFF(IER, 2)
215     
216     ! If gas viscosity is undefined and the flag for calculating gas
217     ! viscosity is turned off: Turn it on and make the call to calc_coeff.
218     ! Once viscosity values have been calculated (i.e., an initial value
219     ! is calculated), turn the flag off again so it isn't recalculated.
220     !         IF(MU_g0 == UNDEFINED .AND. .NOT.VISC(0)) THEN
221     !            VISC(0) = .TRUE.; CALL CALC_COEFF(IER, 2)
222     !            VISC(0) = .FALSE.
223     !         ELSE
224     !            CALL CALC_COEFF(IER, 2)
225     !         ENDIF
226           ENDIF
227     
228           END SUBROUTINE INIT_COEFF
229     
230     !**********************************************************************!
231     !  SUBROUTINE: DEBUG_COEFF                                             !
232     !                                                                      !
233     !  Purpose: Dump the coefficient arrays for debugging.                 !
234     !                                                                      !
235     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
236           SUBROUTINE DEBUG_COEFF
237     
238           use compar
239           use physprop, only: MMAX
240     
241           implicit none
242     
243           INTEGER :: M, MM
244     
245           if(myPE /= PE_IO) return
246     
247           write(*,"(/3x,'From DEBUG_COEFF:')")
248     
249           write(*,"(/3x,'Gas phase coefficients:')")
250           write(*,"( 5x,'Density (RO_g):',1x,1L1)") DENSITY(0)
251           write(*,"( 5x,'Specific heat (C_pg):',1x,1L1)") SP_HEAT(0)
252           write(*,"( 5x,'Viscosity: (MU_g)',1x,1L1)") VISC(0)
253           write(*,"( 5x,'Thermal conductivity (K_g):',1x,1L1)") COND(0)
254           write(*,"( 5x,'Species diffusivity: (DIF_G)',1x,1L1)") DIFF(0)
255     
256     
257           DO M=1, MMAX
258              write(*,"(/3x,'Solids ',I1,' phase coefficients:')") M
259              write(*,"( 5x,'Density: (RO_s)',1x,1L1)") DENSITY(M)
260              write(*,"( 5x,'Specific heat (C_ps):',1x,1L1)") SP_HEAT(M)
261              write(*,"( 5x,'Viscosity (MU_s):',1x,1L1)") VISC(M)
262              write(*,"( 5x,'Thermal conductivity (K_s):',1x,1L1)") COND(M)
263              write(*,"( 5x,'Species diffusivity (DIF_s):',1x,1L1)") DIFF(M)
264              write(*,"( 5x,'Gran. Dissipation (D_p):',1x,1L1)") GRAN_DISS(M)
265              write(*,"( 5x,'Diameter (D_p):',1x,1L1)") PSIZE(M)
266           ENDDO
267     
268     
269           write(*,"(/3x,'Interphase drag:')")
270           write(*,"( 5x,'ref')",ADVANCE="NO")
271           DO M=0, MMAX
272              write(*,"(2x,I3)",ADVANCE="NO")M
273           ENDDO
274           write(*,"('')")
275     
276           DO M=0, MMAX
277              write(*,"( 5x,I3)",ADVANCE="NO") M
278              DO MM=0, MMAX
279                 write(*,"(2x,L3)",ADVANCE="NO")DRAGCOEF(M, MM)
280              ENDDO
281              write(*,"('')")
282           ENDDO
283     
284           write(*,"(/3x,'Interphase heat transfer:')")
285           write(*,"( 5x,'ref')",ADVANCE="NO")
286           DO M=0, MMAX
287              write(*,"(2x,I3)",ADVANCE="NO")M
288           ENDDO
289           write(*,"('')")
290           DO M=0, MMAX
291              write(*,"( 5x,I3)",ADVANCE="NO") M
292              DO MM=0, MMAX
293                 write(*,"(2x,L3)",ADVANCE="NO")HEAT_TR(M, MM)
294              ENDDO
295              write(*,"('')")
296           ENDDO
297     
298           write(*,"(/3x,'DEBUG_COEFF - Exit',3/)")
299     
300           END SUBROUTINE DEBUG_COEFF
301     
302           END MODULE coeff
303