mod_bc_j.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Module name: MOD_BC_J(BC, I_w, J_s, J_n, K_b, PLANE)                !
!  Author: P. Nicoletti                               Date: 10-DEC-91  !
!                                                                      !
!  Purpose: modify the "J" values for the b.c. plane                   !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE mod_bc_j(BCV)

      use bc, only: bc_i_w, bc_i_e
      use bc, only: bc_j_s, bc_j_n
      use bc, only: bc_k_b, bc_k_t
      use bc, only: bc_plane

      USE geometry, only: icbc_flag

      USE compar
      USE mpi_utility

      use error_manager
      USE functions

      IMPLICIT NONE

! boundary condition index
      INTEGER, INTENT(in) :: BCV

! Calculated cell indices in I,J,K directions
      INTEGER :: J_s, J_n
      INTEGER :: I_w, K_b

      INTEGER :: OWNER
      INTEGER :: I, K
      INTEGER :: IJK , IJPK

      INTEGER :: IER
      LOGICAL :: ERROR
      INTEGER :: J_FLUID, IJK_FLUID
      INTEGER :: J_WALL,  IJK_WALL


!-----------------------------------------------

      CALL init_err_msg("MOD_BC_J")

      j_s = bc_j_s(bcv)
      j_n = bc_j_n(bcv)

      i_w = bc_i_w(bcv)
      k_b = bc_k_b(bcv)

! Establish the OWNER of the BC
      owner = merge(mype, 0, is_on_mype_owns(i_w,j_s,k_b))
      CALL global_all_sum(owner)

      IF(mype == owner)THEN

         ijk  = funijk(i_w, j_s,   k_b)
         ijpk = funijk(i_w, j_s+1, k_b)

         IF (wall_icbc_flag(ijk) .AND. icbc_flag(ijpk)(1:1)=='.') THEN
            j_s = j_s
            j_n = j_n
            bc_plane(bcv) = 'N'

         ELSE IF (wall_icbc_flag(ijpk) .AND. icbc_flag(ijk)(1:1)=='.') THEN
            j_s = j_s + 1
            j_n = j_n + 1
            bc_plane(bcv) = 'S'

         ELSE
            bc_plane(bcv) = '.'
         ENDIF
      ENDIF

      CALL bcast(j_s,owner)
      CALL bcast(j_n,owner)
      CALL bcast(bc_plane(bcv),owner)

! If there is an error, send IJK/IPJK to all ranks. Report and exit.
      IF(bc_plane(bcv) == '.') THEN
         CALL bcast(ijpk,owner)
         CALL bcast(ijk, owner)

         WRITE(err_msg, 1100) bcv, j_s, j_n, i_w, k_b,                 &
            ijk, icbc_flag(ijk),  ijpk, icbc_flag(ijpk)
         CALL flush_err_msg(abort=.true.)
      ENDIF

 1100 FORMAT('Error 1100: Cannot locate flow plane for boundary ',     &
         'condition ',i3,'.',2/3x,'J South  =  ',i6,' J North  = ',i6,/&
         3x,'I West   =  ',i6,' K Bottom = ',i6,2/' The following ',   &
         'should conttain a wall cell and fluid cell:',/3x,'IJK  ',i9, &
         ' :: ',a3,/3x,'IJPK ',i9,' :: ',a3,2/' Maybe no IC was ',     &
         'specified for the fluid cell.')

! Store the new values in the global data array.
      bc_j_s(bcv) = j_s
      bc_j_n(bcv) = j_n


      j_wall = bc_j_s(bcv)
      j_fluid = merge(j_wall-1, j_wall+1, bc_plane(bcv)=='S')


! First pass through all of the BC region and verify that you have
! inflow/outflow specified against a wall. Flag any errors.
      error = .false.
      DO k = bc_k_b(bcv), bc_k_t(bcv)
      DO i = bc_i_w(bcv), bc_i_e(bcv)
         IF(.NOT.is_on_mype_plus2layers(i,j_fluid,k)) cycle
         IF(.NOT.is_on_mype_plus2layers(i,j_wall, k)) cycle
         IF(dead_cell_at(i,j_fluid,k)) cycle
         IF(dead_cell_at(i,j_wall, k)) cycle

         ijk_wall  = funijk(i,j_wall, k)
         ijk_fluid = funijk(i,j_fluid,k)

          IF(.NOT.(wall_icbc_flag(ijk_wall) .AND. &
             icbc_flag(ijk_fluid)(1:1)=='.')) error = .true.

       ENDDO
       ENDDO


! Sync up the error flag across all processes.
      CALL global_all_or(error)

! If an error is detected, have each rank open a log file and write
! it's own message. Otherwise, we need to send all the data back to
! PE_IO and that's too much work!
      IF(error) THEN

         CALL open_pe_log(ier)

         WRITE(err_msg, 1200) bcv
         CALL flush_err_msg(footer=.false.)

 1200 FORMAT('Error 1200: Illegal geometry for boundary condition:',i3)

         DO k = bc_k_b(bcv), bc_k_t(bcv)
         DO i = bc_i_w(bcv), bc_i_e(bcv)

            IF(.NOT.is_on_mype_plus2layers(i,j_fluid,k)) cycle
            IF(.NOT.is_on_mype_plus2layers(i,j_wall, k)) cycle
            IF(dead_cell_at(i, j_fluid,k)) cycle
            IF(dead_cell_at(i, j_wall, k)) cycle

            ijk_wall  = funijk(i,j_wall ,k)
            ijk_fluid = funijk(i,j_fluid,k)

            IF(.NOT.(wall_icbc_flag(ijk_wall) .AND.                    &
               icbc_flag(ijk_fluid)(1:1)=='.')) THEN

               WRITE(err_msg, 1201) &
                  i, j_wall,  k, ijk_wall, icbc_flag(ijk_wall),        &
                  i, j_fluid, k, ijk_fluid, icbc_flag(ijk_fluid)
               CALL flush_err_msg(header=.false., footer=.false.)
            ENDIF

 1201 FORMAT(' ',/14x,'I',7x,'J',7x,'K',7x,'IJK',4x,'FLAG',/3x,        &
         'WALL ',3(2x,i6),2x,i9,3x,a,/3x,'FLUID',3(2x,i6),2x,i9,3x,a)

         ENDDO
         ENDDO

         WRITE(err_msg,"('Please correct the mfix.dat file.')")
         CALL flush_err_msg(header=.false., abort=.true.)

      ENDIF

      CALL finl_err_msg

      RETURN
      END SUBROUTINE mod_bc_j