make_arrays_des.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!  Module name: MAKE_ARRAYS_DES                                        !
!  Author: Jay Boyalakuntla                           Date: 12-Jun-04  !
!                                                                      !
!  Purpose: DES - allocating DES arrays
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE make_arrays_des

      USE calc_collision_wall
      USE compar
      use constant, only: pi
      USE cutcell
      USE des_rxns
      USE des_thermo
      USE desgrid
      USE discretelement
      USE error_manager
      USE functions
      USE funits
      use fldvar, only: ro_s
      USE generate_particles, only: generate_particle_config
      USE geometry
      use mfix_pic, only:  mppic
      use mpi_funs_des, only: des_par_exchange
      USE mpi_utility
      USE param1
      use physprop, only: mmax, ro_s0
      USE run
      USE stl
      USE stl_functions_des
      use stl_preproc_des, only: add_facet

      IMPLICIT NONE
!-----------------------------------------------
! Local variables
!-----------------------------------------------
      INTEGER :: I, J, K, L, IJK
      INTEGER :: I1, I2, J1, J2, K1, K2, II, JJ, KK, IJK2
      INTEGER :: lcurpar, lpip_all(0:numpes-1), lglobal_id
      INTEGER :: CELL_ID, I_CELL, J_CELL, K_CELL, COUNT, NF
      INTEGER :: IMINUS1, IPLUS1, JMINUS1, JPLUS1, KMINUS1, KPLUS1

! MPPIC related quantities
      CALL init_err_msg("MAKE_ARRAYS_DES")

! Check interpolation input.
      CALL set_filter_des

! cfassign and des_init_bc called before reading the particle info
      CALL cfassign

      vol_surr(:) = zero

      ! initialize VOL_SURR array
      DO k = kstart2, kend1
         DO j = jstart2, jend1
            DO i = istart2, iend1
               IF (dead_cell_at(i,j,k)) cycle  ! skip dead cells
               ijk = funijk(i,j,k)
               i1 = i
               i2 = i+1
               j1 = j
               j2 = j+1
               k1 = k
               k2 = merge(k, k+1, no_k)

! looping over stencil points (node values)
               DO kk = k1, k2
                  DO jj = j1, j2
                     DO ii = i1, i2
                        IF (dead_cell_at(ii,jj,kk)) cycle  ! skip dead cells
                        ijk2 = funijk_map_c(ii, jj, kk)
                        IF(fluid_at(ijk2)) vol_surr(ijk) = &
                           vol_surr(ijk)+vol(ijk2)
                     ENDDO
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO



! Set the initial particle data.
      IF(run_type == 'NEW') THEN
         IF(particles /= 0) THEN
            IF(gener_part_config) THEN
               CALL generate_particle_config
            ELSE
               CALL read_par_input
            ENDIF
         ENDIF

! Set the global ID for the particles and set the ghost cnt
         ighost_cnt = 0
         lpip_all = 0
         lpip_all(mype) = pip
         call global_all_sum(lpip_all)
         lglobal_id = sum(lpip_all(0:mype-1))
         imax_global_id = 0
         do lcurpar  = 1,pip
            lglobal_id = lglobal_id + 1
            iglobal_id(lcurpar) = lglobal_id
            imax_global_id = iglobal_id(pip)
         end do
         call global_all_max(imax_global_id)

! Initialize old values
         omega_new(:,:)   = zero

! Particle orientation
         IF(particle_orientation) THEN
            orientation(1,:) = init_orientation(1)
            orientation(2,:) = init_orientation(2)
            orientation(3,:) = init_orientation(3)
         ENDIF


         IF (do_old) THEN
            omega_old(:,:)   = zero
            des_pos_old(:,:) = des_pos_new(:,:)
            des_vel_old(:,:) = des_vel_new(:,:)
         ENDIF

! Read the restart file.
      ELSEIF(run_type == 'RESTART_1' .OR. run_type == 'RESTART_2') THEN

         CALL read_res0_des
         imax_global_id = maxval(iglobal_id(1:pip))
         call global_all_max(imax_global_id)

! Initizlie the old values.
         IF (do_old) THEN
            omega_old(:,:)   = omega_new(:,:)
            des_pos_old(:,:) = des_pos_new(:,:)
            des_vel_old(:,:) = des_vel_new(:,:)
         ENDIF

      ELSE

         WRITE(err_msg, 1100)
         CALL flush_err_msg(abort=.true.)
 1100 FORMAT('Error 1100: Unsupported RUN_TYPE for DES.')

      ENDIF

      IF(run_type == 'RESTART_2') vtp_findex=0

! setting additional particle properties now that the particles
! have been identified
      DO l = 1, max_pip
! Skip 'empty' locations when populating the particle property arrays.
         IF(is_nonexistent(l)) cycle
         IF(is_ghost(l) .OR. is_entering_ghost(l) .OR. is_exiting_ghost(l)) cycle
         pvol(l) = (4.0d0/3.0d0)*pi*des_radius(l)**3
         pmass(l) = pvol(l)*ro_sol(l)
         omoi(l) = 2.5d0/(pmass(l)*des_radius(l)**2) !ONE OVER MOI
      ENDDO

      CALL set_phase_index
      CALL init_particles_in_cell

! do_nsearch should be set before calling particle in cell
      do_nsearch =.true.
! Bin the particles to the DES grid.
      CALL desgrid_pic(plocate=.true.)
      CALL des_par_exchange
      CALL particles_in_cell

      IF(dem_solids) THEN
         CALL neighbour
         CALL init_settling_dem
      ENDIF

      IF(run_type == 'NEW') CALL set_ic_dem


! Calculate interpolation weights
      CALL calc_interp_weights
! Calculate mean fields using either interpolation or cell averaging.
      CALL comp_mean_fields

      IF(mppic) CALL calc_dtpic


      IF(run_type /= 'RESTART_1' .AND. print_des_data) THEN
         s_time = time
         CALL write_des_data
      ENDIF

      CALL finl_err_msg

      RETURN
      END SUBROUTINE make_arrays_des