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

1     
2     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
3     !                                                                      !
4     !  SUBROUTINE Name: DES_SET_IC                                         !
5     !                                                                      !
6     !  Purpose: Assign initial conditions to particles basded upon thier   !
7     !  location within the domain.                                         !
8     !                                                                      !
9     !  Author: J.Musser                                   Date: 15-Feb-11  !
10     !                                                                      !
11     !  Comments:                                                           !
12     !                                                                      !
13     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
14           SUBROUTINE SET_IC_DEM
15     
16     
17           use run, only: ENERGY_EQ, SPECIES_EQ
18           use run, only: RUN_TYPE
19     
20           use ic
21     
22           use des_thermo, only: DES_T_s_NEW
23     
24           use discretelement, only: MAX_PIP
25           use discretelement, only: PEA
26           use discretelement, only: PINC, PIC
27           use discretelement, only: PIJK
28     
29           USE des_rxns, only: DES_X_s
30     
31           use physprop, only: C_PS0
32           use physprop, only: SMAX, NMAX
33     
34           USE compar
35           use indices
36           use geometry
37     
38           use error_manager
39           use functions
40           use toleranc
41     
42           IMPLICIT NONE
43     
44     ! Dummy indices
45           INTEGER :: ICV
46           INTEGER :: I, J, K, IJK
47           INTEGER :: M, N
48           INTEGER :: NP
49           INTEGER :: NINDX
50     
51           IF(RUN_TYPE /= 'NEW') RETURN
52     
53           CALL INIT_ERR_MSG("SET_IC_DEM")
54     
55           DO ICV = 1, DIMENSION_IC
56              IF(.NOT.IC_DEFINED(ICV)) CYCLE
57     
58              DO K = IC_K_B(ICV), IC_K_T(ICV)
59              DO J = IC_J_S(ICV), IC_J_N(ICV)
60              DO I = IC_I_W(ICV), IC_I_E(ICV)
61     
62     ! Set the initial conditions for particles in cells that are
63     ! not dead and that this rank owns.
64                 IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
65                 IF (DEAD_CELL_AT(I,J,K)) CYCLE
66     
67                 IJK = FUNIJK(I,J,K)
68     
69     ! Loop through particles in cell IJK.
70                 DO NINDX = 1,PINC(IJK)
71                    NP = PIC(IJK)%P(NINDX)
72     
73     ! Shift the phase index to the absolute phase index.
74                    M = PIJK(NP,5) + SMAX
75     
76     ! Set the initial particle temperature.
77                    IF(ENERGY_EQ) THEN
78                       DES_T_s_NEW(NP) = IC_T_s(ICV,M)
79                    ENDIF
80     
81     ! Set the initial species composition.
82                    IF((ENERGY_EQ .AND. C_Ps0(M) == UNDEFINED) .OR.         &
83                       SPECIES_EQ(M)) THEN
84                       DES_X_s(NP,:) = ZERO
85                       DO N = 1, NMAX(M)
86                          DES_X_s(NP,N) = IC_X_s(ICV,M,N)
87                       ENDDO
88                    ENDIF
89                 ENDDO
90              ENDDO
91              ENDDO
92              ENDDO
93           ENDDO
94     
95     
96     ! Verify that all particles have a specified temperature and species
97     ! mass fractions that sum to one. These checks are needed as the
98     ! basic checks for IC_T_s and IC_X_s can be skipped if the IC region
99     ! is specified with EPg = 1.
100           DO NP = 1, MAX_PIP
101     ! skipping non-existent particles
102              IF(.NOT.PEA(NP,1)) CYCLE
103     ! skipping ghost particles
104              IF(PEA(NP,4)) 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, 2000) 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