File: N:\mfix\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     
17           use ic
18     
19           use des_thermo, only: DES_T_s
20     
21           use derived_types, only: PIC
22           use discretelement, only: MAX_PIP
23           use discretelement, only: PINC
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: 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, NN
47           INTEGER :: NP
48           INTEGER :: NINDX
49     
50           CALL INIT_ERR_MSG("SET_IC_DEM")
51     
52           DO ICV = 1, DIMENSION_IC
53              IF(.NOT.IC_DEFINED(ICV)) CYCLE
54     
55              DO K = IC_K_B(ICV), IC_K_T(ICV)
56              DO J = IC_J_S(ICV), IC_J_N(ICV)
57              DO I = IC_I_W(ICV), IC_I_E(ICV)
58     
59     ! Set the initial conditions for particles in cells that are
60     ! not dead and that this rank owns.
61                 IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
62                 IF (DEAD_CELL_AT(I,J,K)) CYCLE
63     
64                 IJK = FUNIJK(I,J,K)
65     
66     ! Loop through particles in cell IJK.
67                 DO NINDX = 1,PINC(IJK)
68                    NP = PIC(IJK)%P(NINDX)
69     
70     ! Shift the phase index to the absolute phase index.
71                    M = PIJK(NP,5) 
72     
73     ! Set the initial particle temperature.
74                    IF(ENERGY_EQ) THEN
75                       DES_T_s(NP) = IC_T_s(ICV,M)
76                    ENDIF
77     
78     ! Set the initial species composition.
79                    IF((ENERGY_EQ .AND. C_Ps0(M) == UNDEFINED) .OR.         &
80                       SPECIES_EQ(M)) THEN
81                       DES_X_s(NP,:) = ZERO
82                       DO NN = 1, NMAX(M)
83                          DES_X_s(NP,NN) = IC_X_s(ICV,M,NN)
84                       ENDDO
85                    ENDIF
86                 ENDDO
87              ENDDO
88              ENDDO
89              ENDDO
90           ENDDO
91     
92     
93     ! Verify that all particles have a specified temperature and species
94     ! mass fractions that sum to one. These checks are needed as the
95     ! basic checks for IC_T_s and IC_X_s can be skipped if the IC region
96     ! is specified with EPg = 1.
97           DO NP = 1, MAX_PIP
98     ! skipping non-existent particles
99              IF(IS_NONEXISTENT(NP)) CYCLE
100     ! skipping ghost particles
101              IF(IS_GHOST(NP) .OR. IS_ENTERING_GHOST(NP) .OR. IS_EXITING_GHOST(NP)) CYCLE
102              IF(IS_GHOST(NP)) CYCLE
103     
104              M = PIJK(NP,5)
105     
106     ! Check that the temperature is specified.
107              IF(ENERGY_EQ) THEN
108                 IF(DES_T_s(NP) == ZERO) THEN
109                    WRITE(ERR_MSG, 2000) trim(iVal(NP)), trim(iVal(M))
110                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
111                 ENDIF
112              ENDIF
113     
114      2000 FORMAT('Error 2000: Particle ',A,' does not have a specified ',  &
115              'initial',/'temperature. Verify that the IC region ',         &
116              'containing this particle',/'has a solids temperature ',      &
117              'defined: IC_T_s(ICV,',A,').')
118     
119     ! Check that the species mass fractions are specified.
120              IF((ENERGY_EQ .AND. C_Ps0(M) == UNDEFINED) .OR.               &
121                 SPECIES_EQ(M)) THEN
122                 IF(.NOT.COMPARE(sum(DES_X_s(NP,1:NMAX(M))),ONE)) THEN
123                    WRITE(ERR_MSG, 2001) trim(iVal(NP)), trim(iVal(M))
124                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
125                 ENDIF
126              ENDIF
127     
128      2001 FORMAT('Error 2001: The initial species mass fraction for ',     &
129              'particle ',A,/'does not sum to one. Verify that the IC ',    &
130              'region containing this particle',/'has the solids species ', &
131              'mass fractions defined: IC_X_s(ICV,',A,',:).')
132     
133           ENDDO
134     
135           CALL FINL_ERR_MSG
136     
137           RETURN
138           END SUBROUTINE SET_IC_DEM
139