File: RELATIVE:/../../../mfix.git/model/des/set_ic_dem.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  SUBROUTINE Name: DES_SET_IC                                         !
4     !                                                                      !
5     !  Purpose: Assign initial conditions to particles basded upon thier   !
6     !  location within the domain.                                         !
7     !                                                                      !
8     !  Author: J.Musser                                   Date: 15-Feb-11  !
9     !                                                                      !
10     !  Comments:                                                           !
11     !                                                                      !
12     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
13           SUBROUTINE SET_IC_DEM
14     
15           use run, only: ENERGY_EQ, SPECIES_EQ
16           use run, only: RUN_TYPE
17     
18           use ic
19     
20           use des_thermo, only: DES_T_s_NEW
21     
22           use discretelement, only: MAX_PIP
23           use discretelement, only: PINC, PIC
24           use discretelement, only: PIJK
25     
26           USE des_rxns, only: DES_X_s
27     
28           use param1, only: undefined, zero
29     
30           use physprop, only: C_PS0
31           use physprop, only: SMAX, NMAX
32     
33           USE compar
34           use indices
35           use geometry
36     
37           use error_manager
38           use functions
39           use toleranc
40     
41           IMPLICIT NONE
42     
43     ! Dummy indices
44           INTEGER :: ICV
45           INTEGER :: I, J, K, IJK
46           INTEGER :: M, N
47           INTEGER :: NP
48           INTEGER :: NINDX
49     
50           IF(RUN_TYPE /= 'NEW') RETURN
51     
52           CALL INIT_ERR_MSG("SET_IC_DEM")
53     
54           DO ICV = 1, DIMENSION_IC
55              IF(.NOT.IC_DEFINED(ICV)) CYCLE
56     
57              DO K = IC_K_B(ICV), IC_K_T(ICV)
58              DO J = IC_J_S(ICV), IC_J_N(ICV)
59              DO I = IC_I_W(ICV), IC_I_E(ICV)
60     
61     ! Set the initial conditions for particles in cells that are
62     ! not dead and that this rank owns.
63                 IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
64                 IF (DEAD_CELL_AT(I,J,K)) CYCLE
65     
66                 IJK = FUNIJK(I,J,K)
67     
68     ! Loop through particles in cell IJK.
69                 DO NINDX = 1,PINC(IJK)
70                    NP = PIC(IJK)%P(NINDX)
71     
72     ! Shift the phase index to the absolute phase index.
73                    M = PIJK(NP,5) + SMAX
74     
75     ! Set the initial particle temperature.
76                    IF(ENERGY_EQ) THEN
77                       DES_T_s_NEW(NP) = IC_T_s(ICV,M)
78                    ENDIF
79     
80     ! Set the initial species composition.
81                    IF((ENERGY_EQ .AND. C_Ps0(M) == UNDEFINED) .OR.         &
82                       SPECIES_EQ(M)) THEN
83                       DES_X_s(NP,:) = ZERO
84                       DO N = 1, NMAX(M)
85                          DES_X_s(NP,N) = IC_X_s(ICV,M,N)
86                       ENDDO
87                    ENDIF
88                 ENDDO
89              ENDDO
90              ENDDO
91              ENDDO
92           ENDDO
93     
94     
95     ! Verify that all particles have a specified temperature and species
96     ! mass fractions that sum to one. These checks are needed as the
97     ! basic checks for IC_T_s and IC_X_s can be skipped if the IC region
98     ! is specified with EPg = 1.
99           DO NP = 1, MAX_PIP
100     ! skipping non-existent particles
101              IF(IS_NONEXISTENT(NP)) CYCLE
102     ! skipping ghost particles
103              IF(IS_GHOST(NP) .OR. IS_ENTERING_GHOST(NP) .OR. IS_EXITING_GHOST(NP)) CYCLE
104              IF(IS_GHOST(NP)) CYCLE
105     
106              M = PIJK(NP,5)
107     
108     ! Check that the temperature is specified.
109              IF(ENERGY_EQ) THEN
110                 IF(DES_T_s_NEW(NP) == ZERO) THEN
111                    WRITE(ERR_MSG, 2000) trim(iVal(NP)), trim(iVal(M))
112                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
113                 ENDIF
114              ENDIF
115     
116      2000 FORMAT('Error 2000: Particle ',A,' does not have a specified ',  &
117              'initial',/'temperature. Verify that the IC region ',         &
118              'containing this particle',/'has a solids temperature ',      &
119              'defined: IC_T_s(ICV,',A,').')
120     
121     ! Check that the species mass fractions are specified.
122              IF((ENERGY_EQ .AND. C_Ps0(M) == UNDEFINED) .OR.               &
123                 SPECIES_EQ(M)) THEN
124                 IF(.NOT.COMPARE(sum(DES_X_s(NP,1:NMAX(M))),ONE)) THEN
125                    WRITE(ERR_MSG, 2001) trim(iVal(NP)), trim(iVal(M))
126                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
127                 ENDIF
128              ENDIF
129     
130      2001 FORMAT('Error 2001: The initial species mass fraction for ',     &
131              'particle ',A,/'does not sum to one. Verify that the IC ',    &
132              'region containing this particle',/'has the solids species ', &
133              'mass fractions defined: IC_X_s(ICV,',A,',:).')
134     
135           ENDDO
136     
137     ! Calculate the average solids temperature in each fluid cell
138           CALL SET_INIT_avgTs
139     
140           CALL FINL_ERR_MSG
141     
142           RETURN
143           END SUBROUTINE SET_IC_DEM
144