set_bc_dem_mo.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: SET_BC_DEM_MO                                           !
!                                                                      !
!                                                                      !
!  Author: J.Musser                                   Date: 23-Nov-09  !
!                                                                      !
!  Comments:                                                           !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE set_bc_dem_mo

      use bc, only: bc_plane
      use bc, only: bc_x_w, bc_x_e, bc_y_s, bc_y_n, bc_z_b, bc_z_t

      use des_bc, only: dem_bcmo, dem_bcmo_map, dem_bcmo_ijk
      use des_bc, only: dem_bcmo_ijkstart, dem_bcmo_ijkend

      use funits, only: dmp_log

      use mpi_utility
      use error_manager
      use functions

      use desgrid, only: dg_funijk
      use desgrid, only: iofpos, jofpos, kofpos
      use desgrid, only: dg_is_on_mype_plus1layers

      IMPLICIT NONE

!-----------------------------------------------
! Local variables
!-----------------------------------------------
      INTEGER :: BCV, BCV_I      ! BC loop counter

      INTEGER :: LC

      LOGICAL, parameter :: setDBG = .false.
      LOGICAL :: dFlag

      INTEGER :: MAX_CELLS, BND1, BND2

      INTEGER, ALLOCATABLE :: LOC_DEM_BCMO_IJK(:)

      INTEGER :: I,J,K,IJK
      INTEGER :: I_w, I_e, J_s, J_n, K_b, K_t

      CALL init_err_msg("SET_BC_DEM_MO")


! Initialize the data structures:
      allocate( dem_bcmo_ijkstart(dem_bcmo) )
      allocate( dem_bcmo_ijkend(dem_bcmo) )

      dem_bcmo_ijkstart = -1
      dem_bcmo_ijkend   = -1

      dflag = (dmp_log .AND. setdbg)
      if(dflag) write(*,"(2/,2x,'DEM outlet count: ',I4)") dem_bcmo

! Loop over the outflow BCs to get an approximate count of the number
! of fluid cells that are adjacent to the outlet.
      max_cells = 0
      DO bcv_i = 1, dem_bcmo
         bcv = dem_bcmo_map(bcv_i)

! Set the search area to the dimensions of the inlet.
         if(dflag) WRITE(*,"(/2x,'Adding cells for BCV: ',I3)") bcv
         SELECT CASE (bc_plane(bcv))
         CASE('N','S')
            bnd1 = iofpos(bc_x_e(bcv)) - iofpos(bc_x_w(bcv))
            bnd2 = kofpos(bc_z_t(bcv)) - kofpos(bc_z_b(bcv))

         CASE('E','W')
            bnd1 = jofpos(bc_y_n(bcv)) - jofpos(bc_y_s(bcv))
            bnd2 = kofpos(bc_z_t(bcv)) - kofpos(bc_z_b(bcv))

         CASE('T','B')
            bnd1 = iofpos(bc_x_e(bcv)) - iofpos(bc_x_w(bcv))
            bnd2 = jofpos(bc_y_n(bcv)) - jofpos(bc_y_s(bcv))
         END SELECT

         max_cells = max_cells +                                      &
            2*(bnd1+1)*(bnd2+1) + 2*(bnd1+2) + 2*(bnd2+2)

         if(dflag) WRITE(*,"(4x,'Plane:   ',A)") bc_plane(bcv)
         if(dflag) WRITE(*,"(4x,'Cells: ', I8)") (bnd1+1)*(bnd2+1)
      ENDDO

      if(dflag) write(*,"(2x,'Max Cells: ',I8)") max_cells

! Allocate an array to hold the IJK values. This array should be
! more than enough to store all the IJKs.
      allocate( loc_dem_bcmo_ijk(max_cells) )

! Loop over the IJKs for each BC and store only the IJKs that you
! own as well as the start/end array positions for each BC.
      lc = 1
      DO bcv_i = 1, dem_bcmo

         dem_bcmo_ijkstart(bcv_i) = lc
         bcv = dem_bcmo_map(bcv_i)

         if(dflag) write(*,"(/2x,'Searching for fluid cells:',I3)") bcv

         i_w = iofpos(bc_x_w(bcv)); i_e = iofpos(bc_x_e(bcv))
         j_s = jofpos(bc_y_s(bcv)); j_n = jofpos(bc_y_n(bcv))
         IF(do_k) THEN
            k_b = kofpos(bc_z_b(bcv)); k_t = kofpos(bc_z_t(bcv))
         ELSE
            k_b = 1; k_t = 1
         ENDIF

! Depending on the flow plane, the 'common' index needs shifted to
! reference the fluid cell.
         SELECT CASE (bc_plane(bcv))
         CASE('N'); j_s = j_s+1;  j_n = j_s
         CASE('S'); j_s = j_s-1;  j_n = j_s
         CASE('E'); i_w = i_w+1;  i_e = i_w
         CASE('W'); i_w = i_w-1;  i_e = i_w
         CASE('T'); k_b = k_b+1;  k_t = k_b
         CASE('B'); k_b = k_b-1;  k_t = k_b
        END SELECT

         if(dflag) then
            write(*,"(4x,'Search bounds: ')")
            write(*,"(6x,'I_w/I_e:',2(2x,I6))") i_w, i_e
            write(*,"(6x,'J_s/J_n:',2(2x,I6))") j_s, j_n
            write(*,"(6x,'K_b/K_t:',2(2x,I6))") k_b, k_t
         endif

! Store the IJKs.
         DO k = k_b, k_t
         DO j = j_s, j_n
         DO i = i_w, i_e
! Skip cells that this rank does not own or are considered dead.
            IF(.NOT.dg_is_on_mype_plus1layers(i,j,k))cycle

            ijk = dg_funijk(i,j,k)
            loc_dem_bcmo_ijk(lc) = ijk
            lc = lc+1
         ENDDO
         ENDDO
         ENDDO

         if(dflag) write(*,"(/2x,'Adding boundary cells:',I3)") bcv

         i_w = iofpos(bc_x_w(bcv))-1; i_e = iofpos(bc_x_e(bcv))+1
         j_s = jofpos(bc_y_s(bcv))-1; j_n = jofpos(bc_y_n(bcv))+1

         IF(do_k) THEN
            k_b = kofpos(bc_z_b(bcv))-1; k_t = kofpos(bc_z_t(bcv))+1
         ELSE
            k_b = 1;   k_t = 1
         ENDIF

! Depending on the flow plane, the 'common' index needs shifted to
! reference the fluid cell.
         SELECT CASE (bc_plane(bcv))
         CASE('N','S'); j_s = j_s+1;  j_n = j_n-1
         CASE('E','W'); i_w = i_w+1;  i_e = i_e-1
         CASE('T','B'); k_b = k_b+1;  k_t = k_t-1
         END SELECT

         if(dflag) then
            write(*,"(4x,'Search bounds: ')")
            write(*,"(6x,'I_w/I_e:',2(2x,I6))") i_w, i_e
            write(*,"(6x,'J_s/J_n:',2(2x,I6))") j_s, j_n
            write(*,"(6x,'K_b/K_t:',2(2x,I6))") k_b, k_t
         endif

! Store the IJKs.
         DO k = k_b, k_t
         DO j = j_s, j_n
         DO i = i_w, i_e
! Skip cells that this rank does not own or are considered dead.
            IF(.NOT.dg_is_on_mype_plus1layers(i,j,k))cycle

            ijk = dg_funijk(i,j,k)
            loc_dem_bcmo_ijk(lc) = ijk
            lc = lc+1
         ENDDO
         ENDDO
         ENDDO

         dem_bcmo_ijkend(bcv_i) = lc-1

         if(dflag) write(*,1111) bcv, bcv_i,                           &
            dem_bcmo_ijkstart(bcv_i),dem_bcmo_ijkend(bcv_i)

      ENDDO

 1111 FORMAT(/2x,'DEM Mass Outflow:',/4x,'BC:',i4,3x,'MAP:',i4,&
         /4x,'IJKSTART:',i6,/4x,'IJKEND:  ',i6)

! Allocate the global store arrary array. This changes across MPI ranks.
      IF(lc > 1) THEN
         allocate( dem_bcmo_ijk(lc-1) )
         dem_bcmo_ijk(1:lc-1) = loc_dem_bcmo_ijk(1:lc-1)
      ELSE
         allocate( dem_bcmo_ijk(1) )
         dem_bcmo_ijk(1) = loc_dem_bcmo_ijk(1)
      ENDIF

      deallocate(loc_dem_bcmo_ijk)

      CALL finl_err_msg

      RETURN
      END SUBROUTINE set_bc_dem_mo


!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Module name: CHECK_DES_LE_BC                                        !
!                                                                      !
!  Purpose: Check/set parameters for DES Lees Edeards BC.              !
!                                                                      !
!  Author: J.Musser                                   Date: 11-DEC-13  !
!                                                                      !
!  Comments: *** DES Lees Edwards BC funcionality has been lost. ***   !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE check_des_le_bc

      use discretelement
      use exit, only: mfix_exit
      use mpi_utility

      IMPLICIT NONE

! Lees Edwards BC functionality has been lost in current DEM code
      IF(des_le_bc) THEN
         IF (des_continuum_coupled) THEN
            WRITE(unit_log, 1064)
             CALL mfix_exit(mype)
         ENDIF
         IF (des_neighbor_search .NE. 4) THEN
            WRITE(unit_log, 1060)
            CALL mfix_exit(mype)
         ENDIF
! not all possible shear directions are fully coded
         IF (dimn .EQ. 2) THEN
            IF(trim(des_le_shear_dir) .NE. 'DUDY' .AND. &
               trim(des_le_shear_dir) .NE. 'DVDX') THEN
               WRITE(unit_log, 1061)
               CALL mfix_exit(mype)
            ENDIF
         ELSEIF(dimn.EQ.3) THEN
            IF(trim(des_le_shear_dir) .NE. 'DUDY') THEN ! .AND. &
!               TRIM(DES_LE_SHEAR_DIR) .NE. 'DUDZ' .AND. &
!               TRIM(DES_LE_SHEAR_DIR) .NE. 'DVDX' .AND. &
!               TRIM(DES_LE_SHEAR_DIR) .NE. 'DVDZ' .AND. &
!               TRIM(DES_LE_SHEAR_DIR) .NE. 'DWDX' .AND. &
!               TRIM(DES_LE_SHEAR_DIR) .NE. 'DWDY') THEN
               WRITE(unit_log, 1062)
               CALL mfix_exit(mype)
            ENDIF
         ENDIF
         IF (des_periodic_walls) THEN
            des_periodic_walls = .false.
            des_periodic_walls_x = .false.
            des_periodic_walls_y = .false.
            des_periodic_walls_z = .false.
            WRITE(unit_log, 1063)
            WRITE(*,1063)
         ENDIF
      ENDIF

      RETURN

 1060 FORMAT(/1x,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
         'Only the grid based search option is allowed when using',&
         'using',/10x,'Lees & Edwards BC.',/1x,70('*')/)

 1061 FORMAT(/1x,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
         'Invalid option for DES_LE_SHEAR_DIR in mfix.dat. When',/10x,&
         'DIMN=2 shear options are DUDY or DVDX',/1x,70('*')/)

 1062 FORMAT(/1x,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
         'Invalid option for DES_LE_SHEAR_DIR in mfix.dat. When',/10x,&
         'DIMN=3 shear options are DUDY, DUDZ, DVDX, DVDZ, DWDX or',&
         'DWDY.',/1x,70('*')/)

 1063 FORMAT(/1x,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
         'WARNING: DES_PERIODIC_WALLS set to false when DES_LE_BC.',&
         /10x,'DES_LE_BC implies periodic walls, however, the ',&
         'periodicity is handled',/10x, 'independently of ',&
         'DES_PERIODIC_WALLS option and so it is shut off.',&
         /1x,70('*')/)

 1064 FORMAT(/1x,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
         'DES_CONTINUUM_COUPLED cannot be true when using ',&
         'DES_LE_BC.',/1x,70('*')/)

      END SUBROUTINE check_des_le_bc