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