File: /nfs/home/0/users/jenkins/mfix.git/model/des/set_phase_index.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: SET_PHASE_INDEX                                         !
4     !                                                                      !
5     !  Purpose: Set the index of all particles based on their diameter and !
6     !  density.                                                            !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE SET_PHASE_INDEX
10     
11           USE physprop, only: SMAX
12     
13           use discretelement, only: PEA, PIJK
14           USE discretelement, only: DES_POS_NEW, DES_RADIUS, RO_SOL
15           USE discretelement, only: DES_MMAX, DES_D_P0, DES_RO_s
16           USE discretelement, only: MAX_PIP
17           use mpi_funs_des, only: des_par_exchange
18     
19           USE run, only: RUN_TYPE
20           USE run, only: ANY_SPECIES_EQ
21     
22           use mpi_utility
23           use sendrecv
24     
25           USE error_manager
26     
27           IMPLICIT NONE
28     !-----------------------------------------------
29     ! Local Variables
30     !-----------------------------------------------
31     ! particle no.
32           INTEGER :: L
33     ! solids phase no.
34           INTEGER :: M
35     ! IER for error reporting
36           INTEGER :: IER
37     ! Difference between a particles diameter (density) and the diameter
38     ! (density) of a phase specified in the data file.
39           DOUBLE PRECISION dDp, dRho
40     
41     ! The restart file contains the phase index for reacting cases as the
42     ! diameter and/or density of the particle may have changed.
43           IF(RUN_TYPE /= 'NEW' .AND. ANY_SPECIES_EQ) RETURN
44     
45     ! Initialize the error flag.
46           IER = 0
47     
48     ! solids phase index of particle.
49     ! ---------------------------------------------------------------->>>
50           DO L = 1, MAX_PIP
51              IF(.NOT.PEA(L,1)) CYCLE
52              IF(PEA(L,4)) CYCLE
53     
54     ! Determining the solids phase of each particle by matching the diameter
55     ! and density to those specified in the data file.
56              M_LP: DO M = 1, DES_MMAX
57                 dDp  = ABS(2.0d0*DES_RADIUS(L)-DES_D_P0(M))
58                 dRho = ABS( RO_Sol(L)-DES_RO_S(M))
59                 IF( dDp < SMALL_NUMBER .AND. dRho < SMALL_NUMBER) THEN
60                    PIJK(L,5) = M
61                    EXIT M_LP
62                 ENDIF
63              ENDDO M_LP
64     ! Flag error if no match is found.
65              IF(PIJK(L,5).EQ.0) IER = 1
66           ENDDO
67     
68     ! Sync up the error flag across all processes.
69           CALL GLOBAL_ALL_SUM(IER)
70           IF(IER == 0) RETURN
71     
72     ! Point of no return: Report errors and abort
73     !----------------------------------------------------------------------
74           CALL INIT_ERR_MSG("SET_PHASE_INDEX")
75     
76           CALL OPEN_PE_LOG(IER)
77     
78           WRITE(ERR_MSG, 1100)
79           CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
80     
81      1100 FORMAT('Error 1100: Unable to determine the phase of one or ',&
82              'more particles.',/8x,'ID',4X,'Diameter',6x,'Density',/)
83     
84           DO L = 1, MAX_PIP
85     ! skipping particles that do not exist
86              IF(.NOT.PEA(L,1)) CYCLE
87              IF(PEA(L,4)) CYCLE
88     
89     ! Flag as an error if no match is found.
90              IF(PIJK(L,5).EQ.0) THEN
91                 WRITE(ERR_MSG,9000) L,  2.0*DES_RADIUS(L), Ro_Sol(L)
92                 CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
93              ENDIF
94           ENDDO
95     
96           WRITE(ERR_MSG, 1101)
97           CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
98     
99      1101 FORMAT(' ',/'Defined phase parameters from mfix.dat:',/3x,'ID',&
100              5X,'Diameter',5x,'Density')
101     
102           DO M = 1, DES_MMAX
103              WRITE(ERR_MSG, 9000) SMAX+M, DES_D_P0(M), DES_RO_S(M)
104              CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
105           ENDDO
106     
107           WRITE(ERR_MSG, 1102)
108           CALL FLUSH_ERR_MSG(HEADER=.FALSE., ABORT=.TRUE.)
109     
110      1102 FORMAT('Please correct the mfix.dat or particle_input.dat files.')
111     
112      9000 FORMAT(I10,2(2x,g12.5))
113     
114           END SUBROUTINE SET_PHASE_INDEX
115