set_ic_dem.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  SUBROUTINE Name: DES_SET_IC                                         !
!                                                                      !
!  Purpose: Assign initial conditions to particles basded upon thier   !
!  location within the domain.                                         !
!                                                                      !
!  Author: J.Musser                                   Date: 15-Feb-11  !
!                                                                      !
!  Comments:                                                           !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE set_ic_dem

      use run, only: energy_eq, species_eq

      use ic

      use des_thermo, only: des_t_s

      use derived_types, only: pic
      use discretelement, only: max_pip
      use discretelement, only: pinc
      use discretelement, only: pijk

      USE des_rxns, only: des_x_s

      use param1, only: undefined, zero

      use physprop, only: c_ps0
      use physprop, only: nmax

      USE compar
      use indices
      use geometry

      use error_manager
      use functions
      use toleranc

      IMPLICIT NONE

! Dummy indices
      INTEGER :: ICV
      INTEGER :: I, J, K, IJK
      INTEGER :: M, NN
      INTEGER :: NP
      INTEGER :: NINDX

      CALL init_err_msg("SET_IC_DEM")

      DO icv = 1, dimension_ic
         IF(.NOT.ic_defined(icv)) cycle

         DO k = ic_k_b(icv), ic_k_t(icv)
         DO j = ic_j_s(icv), ic_j_n(icv)
         DO i = ic_i_w(icv), ic_i_e(icv)

! Set the initial conditions for particles in cells that are
! not dead and that this rank owns.
            IF (.NOT.is_on_mype_plus2layers(i,j,k)) cycle
            IF (dead_cell_at(i,j,k)) cycle

            ijk = funijk(i,j,k)

! Loop through particles in cell IJK.
            DO nindx = 1,pinc(ijk)
               np = pic(ijk)%P(nindx)

! Shift the phase index to the absolute phase index.
               m = pijk(np,5) 

! Set the initial particle temperature.
               IF(energy_eq) THEN
                  des_t_s(np) = ic_t_s(icv,m)
               ENDIF

! Set the initial species composition.
               IF((energy_eq .AND. c_ps0(m) == undefined) .OR.         &
                  species_eq(m)) THEN
                  des_x_s(np,:) = zero
                  DO nn = 1, nmax(m)
                     des_x_s(np,nn) = ic_x_s(icv,m,nn)
                  ENDDO
               ENDIF
            ENDDO
         ENDDO
         ENDDO
         ENDDO
      ENDDO


! Verify that all particles have a specified temperature and species
! mass fractions that sum to one. These checks are needed as the
! basic checks for IC_T_s and IC_X_s can be skipped if the IC region
! is specified with EPg = 1.
      DO np = 1, max_pip
! skipping non-existent particles
         IF(is_nonexistent(np)) cycle
! skipping ghost particles
         IF(is_ghost(np) .OR. is_entering_ghost(np) .OR. is_exiting_ghost(np)) cycle
         IF(is_ghost(np)) cycle

         m = pijk(np,5)

! Check that the temperature is specified.
         IF(energy_eq) THEN
            IF(des_t_s(np) == zero) THEN
               WRITE(err_msg, 2000) trim(ival(np)), trim(ival(m))
               CALL flush_err_msg(abort=.true.)
            ENDIF
         ENDIF

 2000 FORMAT('Error 2000: Particle ',a,' does not have a specified ',  &
         'initial',/'temperature. Verify that the IC region ',         &
         'containing this particle',/'has a solids temperature ',      &
         'defined: IC_T_s(ICV,',a,').')

! Check that the species mass fractions are specified.
         IF((energy_eq .AND. c_ps0(m) == undefined) .OR.               &
            species_eq(m)) THEN
            IF(.NOT.compare(sum(des_x_s(np,1:nmax(m))),one)) THEN
               WRITE(err_msg, 2001) trim(ival(np)), trim(ival(m))
               CALL flush_err_msg(abort=.true.)
            ENDIF
         ENDIF

 2001 FORMAT('Error 2001: The initial species mass fraction for ',     &
         'particle ',a,/'does not sum to one. Verify that the IC ',    &
         'region containing this particle',/'has the solids species ', &
         'mass fractions defined: IC_X_s(ICV,',a,',:).')

      ENDDO

      CALL finl_err_msg

      RETURN
      END SUBROUTINE set_ic_dem