File: RELATIVE:/../../../mfix.git/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
49           USE run, only: gtsh_2012
50           USE run, only: ia_2005
51     ! Run-time flag for invoking DQMOM
52           use run, only: CALL_DQMOM
53     ! Real number of solids phases (GHD theory)
54           use physprop, only: SMAX
55     ! Run-time flag for to solve energy equations.
56           use run, only: ENERGY_EQ
57     ! Run-time flag for to solve species equations.
58           use run, only: SPECIES_EQ
59     ! Flag to recalculate gas viscosity.
60           use visc_g, only: RECALC_VISC_G
61     ! Run-time flag for invoking discrete element model
62           use discretelement, only: DISCRETE_ELEMENT
63     ! Run-time flag for gas/DEM coupling
64           use discretelement, only: DES_CONTINUUM_COUPLED
65     ! Run-time flag for invoking TFM/DEM hybrid model
66           use discretelement, only: DES_CONTINUUM_HYBRID
67     ! Run-time flag invoking QMOM theory
68           use qmom_kinetic_equation, only: QMOMK
69     ! Specified constant gas phase density (incompressible)
70           use physprop, only: RO_G0
71     ! Specified constant specific heat.
72           use physprop, only: C_PG0, C_PS0
73     ! Specified constant thermal conductivity.
74           use physprop, only: K_G0, K_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     ! UDF flags for physical properties
82           use run, only: USR_ROg, USR_ROs, USR_CPg, USR_CPs
83     ! MMS flag
84           use mms, only: USE_MMS
85           implicit none
86     
87     ! Dummy Arguments:
88     !-----------------------------------------------------------------------
89     ! Error flag.
90           INTEGER, intent(inout) :: IER
91     
92     
93     ! Local Variables.
94     !-----------------------------------------------------------------------
95     ! Invoke debug routine:
96           LOGICAL, parameter :: dbg_coeffs = .FALSE.
97     ! Loop counter for solids phases
98           INTEGER :: M
99     
100     ! Allocate and initialize:
101     !```````````````````````````````````````````````````````````````````````
102           IF(.NOT.allocated(DENSITY)) allocate( DENSITY(0:DIMENSION_M))
103           IF(.NOT.allocated(SP_HEAT)) allocate( SP_HEAT(0:DIMENSION_M))
104           IF(.NOT.allocated(PSIZE)) allocate( PSIZE(0:DIMENSION_M))
105     
106           DENSITY = .FALSE.
107           SP_HEAT = .FALSE.
108           PSIZE   = .FALSE.
109     
110           IF(.NOT.allocated(VISC)) allocate( VISC(0:DIMENSION_M))
111           IF(.NOT.allocated(COND)) allocate( COND(0:DIMENSION_M))
112           IF(.NOT.allocated(DIFF)) allocate( DIFF(0:DIMENSION_M))
113           IF(.NOT.allocated(GRAN_DISS)) allocate( GRAN_DISS(0:DIMENSION_M))
114     
115           VISC = .FALSE.
116           COND = .FALSE.
117           DIFF = .FALSE.
118           GRAN_DISS = .FALSE.
119     
120           IF(.NOT.allocated(DRAGCOEF)) &
121              allocate( DRAGCOEF(0:DIMENSION_M,0:DIMENSION_M))
122           IF(.NOT.allocated(HEAT_TR)) &
123              allocate( HEAT_TR(0:DIMENSION_M,0:DIMENSION_M))
124     
125           DRAGCOEF = .FALSE.
126           HEAT_TR = .FALSE.
127     
128     ! Coefficients for gas phase parameters.
129     !```````````````````````````````````````````````````````````````````````
130     ! Compressible flow.
131           if(RO_G0 == UNDEFINED .OR. USR_ROg) DENSITY(0) = .TRUE.
132     ! Viscosity is recalculated iteration-to-iteration if:
133     ! 1) the energy equations are solved
134     ! 2) a turbulace length scale is defined (L_SCALE0 /= ZERO)
135     ! 3) K-Epsilon model is used.
136           VISC(0) = RECALC_VISC_G
137     ! Specific heat and thermal conductivity.
138           if(ENERGY_EQ) then
139              if(C_PG0 == UNDEFINED) SP_HEAT(0) = .TRUE.
140              if(K_G0  == UNDEFINED) COND(0) = .TRUE.
141           endif
142           if(USR_CPg) SP_HEAT(0) = .TRUE.
143     ! Species diffusivity.
144           if(SPECIES_EQ(0)) DIFF(0) = .TRUE.
145     
146     
147     ! Interphase transfer terms.
148     !```````````````````````````````````````````````````````````````````````
149            if(.NOT.QMOMK .AND. .NOT.USE_MMS) DRAGCOEF(0:MMAX,0:MMAX)=.TRUE.
150     
151     ! Coefficients for solids phase parameters.
152     !```````````````````````````````````````````````````````````````````````
153           IF (.NOT.DISCRETE_ELEMENT .OR. DES_CONTINUUM_HYBRID) THEN
154     ! Interphase heat transfer coefficient (GAMA)
155              if(ENERGY_EQ .AND. .NOT.USE_MMS) HEAT_TR(0:MMAX,0:MMAX)=.TRUE.
156     
157     ! Variable solids density.
158              if(any(SOLVE_ROs)) DENSITY(1:MMAX) = .TRUE.
159              if(USR_ROs) DENSITY(1:MMAX) = .TRUE.
160     
161     ! Solids viscosity.
162     !         DO M = 1, MMAX
163     !            IF (MU_s0(M) == UNDEFINED) THEN
164     !               VISC(M) = .TRUE.
165     !            ENDIF
166     !         ENDDO
167     ! Calc_mu_s must be invoked every iteration even if constant viscosity
168     ! (mu_s0 /= undefined) to incorporate ishii form of governing equations
169     ! wherein the viscosity is multiplied by the phase volume fraction
170              VISC(1:MMAX) = .TRUE.
171     
172     ! Specific heat and thermal conductivity.
173              do M=1,MMAX
174                 if(ENERGY_EQ) THEN
175                    if(C_PS0(M) == UNDEFINED) SP_HEAT(M) = .TRUE.
176                    if(K_S0(M)  == UNDEFINED) COND(M) = .TRUE.
177                 endif
178                 if(USR_CPS) SP_HEAT(M) = .TRUE.
179              enddo
180     
181     ! Species diffusivity. There is no reason to invoke this routine as the
182     ! diffusion coefficient for solids is always zero.
183              DIFF(1:MMAX) = .FALSE.
184     
185     ! Particle-Particle Energy Dissipation
186              IF (KT_TYPE_ENUM == IA_2005 .OR. &
187                  KT_TYPE_ENUM == GD_1999 .OR. &
188                  KT_TYPE_ENUM == GTSH_2012) THEN
189                 GRAN_DISS(:MMAX) = .TRUE.
190              ENDIF
191     
192     ! Particle diameter.
193              if(Call_DQMOM) PSIZE(1:SMAX)=.TRUE.
194     
195           ENDIF   ! end if (.not.discrete_element .or des_continuum_hybrid)
196     
197           if(dbg_coeffs) CALL DEBUG_COEFF
198     
199     ! Invoke calc_coeff.
200           IF(.NOT.DISCRETE_ELEMENT .OR. DES_CONTINUUM_COUPLED) THEN
201     ! If gas viscosity is undefined and the flag for calculating gas
202     ! viscosity is turned off: Turn it on and make the call to calc_coeff.
203     ! Once viscosity values have been calculated (i.e., an initial value
204     ! is calculated), turn the flag off again so it isn't recalculated.
205              IF(MU_g0 == UNDEFINED .AND. .NOT.VISC(0)) THEN
206                 VISC(0) = .TRUE.; CALL CALC_COEFF(IER, 2)
207                 VISC(0) = .FALSE.
208              ELSE
209                 CALL CALC_COEFF(IER, 2)
210              ENDIF
211           ENDIF
212     
213           END SUBROUTINE INIT_COEFF
214     
215     !**********************************************************************!
216     !  SUBROUTINE: DEBUG_COEFF                                             !
217     !                                                                      !
218     !  Purpose: Dump the coefficient arrays for debugging.                 !
219     !                                                                      !
220     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
221           SUBROUTINE DEBUG_COEFF
222     
223           use compar
224           use physprop, only: MMAX
225     
226           implicit none
227     
228           INTEGER :: M, MM
229     
230           if(myPE /= PE_IO) return
231     
232           write(*,"(/3x,'From DEBUG_COEFF:')")
233     
234           write(*,"(/3x,'Gas phase coefficients:')")
235           write(*,"( 5x,'Density (RO_g):',1x,1L1)") DENSITY(0)
236           write(*,"( 5x,'Specific heat (C_pg):',1x,1L1)") SP_HEAT(0)
237           write(*,"( 5x,'Viscosity: (MU_g)',1x,1L1)") VISC(0)
238           write(*,"( 5x,'Thermal conductivity (K_g):',1x,1L1)") COND(0)
239           write(*,"( 5x,'Species diffusivity: (DIF_G)',1x,1L1)") DIFF(0)
240     
241     
242           DO M=1, MMAX
243              write(*,"(/3x,'Solids ',I1,' phase coefficients:')") M
244              write(*,"( 5x,'Density: (RO_s)',1x,1L1)") DENSITY(M)
245              write(*,"( 5x,'Specific heat (C_ps):',1x,1L1)") SP_HEAT(M)
246              write(*,"( 5x,'Viscosity (MU_s):',1x,1L1)") VISC(M)
247              write(*,"( 5x,'Thermal conductivity (K_s):',1x,1L1)") COND(M)
248              write(*,"( 5x,'Species diffusivity (DIF_s):',1x,1L1)") DIFF(M)
249              write(*,"( 5x,'Gran. Dissipation (D_p):',1x,1L1)") GRAN_DISS(M)
250              write(*,"( 5x,'Diameter (D_p):',1x,1L1)") PSIZE(M)
251           ENDDO
252     
253     
254           write(*,"(/3x,'Interphase drag:')")
255           write(*,"( 5x,'ref')",ADVANCE="NO")
256           DO M=0, MMAX
257              write(*,"(2x,I3)",ADVANCE="NO")M
258           ENDDO
259           write(*,"('')")
260     
261           DO M=0, MMAX
262              write(*,"( 5x,I3)",ADVANCE="NO") M
263              DO MM=0, MMAX
264                 write(*,"(2x,L3)",ADVANCE="NO")DRAGCOEF(M, MM)
265              ENDDO
266              write(*,"('')")
267           ENDDO
268     
269           write(*,"(/3x,'Interphase heat transfer:')")
270           write(*,"( 5x,'ref')",ADVANCE="NO")
271           DO M=0, MMAX
272              write(*,"(2x,I3)",ADVANCE="NO")M
273           ENDDO
274           write(*,"('')")
275           DO M=0, MMAX
276              write(*,"( 5x,I3)",ADVANCE="NO") M
277              DO MM=0, MMAX
278                 write(*,"(2x,L3)",ADVANCE="NO")HEAT_TR(M, MM)
279              ENDDO
280              write(*,"('')")
281           ENDDO
282     
283           write(*,"(/3x,'DEBUG_COEFF - Exit',3/)")
284     
285           END SUBROUTINE DEBUG_COEFF
286     
287           END MODULE coeff
288