set_icbc_flags.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
! Subroutine: SET_ICBC_FLAG                                            !
! Author: J.Musser                                    Date: 01-Mar-14  !
!                                                                      !
! Purpose: Provided a detailed error message when the sum of volume    !
!                                                                      !
!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
      SUBROUTINE set_icbc_flag


      CALL init_icbc_flag

      CALL set_ic_flags

      CALL set_bc_flags_wall

      CALL set_bc_flags_flow

! Verify that ICBC flags are set for all fluid cells.
      CALL check_icbc_flag

      END SUBROUTINE set_icbc_flag



!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
! Subroutine: INIT_ICBC_FLAG                                           !
! Author: J.Musser                                    Date: 01-Mar-14  !
!                                                                      !
! Purpose: Provided a detailed error message when the sum of volume    !
!                                                                      !
!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
      SUBROUTINE init_icbc_flag

      use param1, only: zero
      use run, only: run_type

      use mpi_utility
      use functions

      implicit none
      INTEGER :: I, J, K, IJK

! Initialize the icbc_flag array.
      DO k = kstart3, kend3
      DO j = jstart3, jend3
      DO i = istart3, iend3

         ijk = funijk(i,j,k)

! Initialize the ICBC Flag
         icbc_flag(ijk) = merge('   ', '.--', run_type == 'NEW')

! If at domain boundaries then set default values (wall or, if
! specified, cyclic)
         IF (do_k) THEN
            IF(k==kmin3 .OR. k==kmin2 .OR. k==kmax2 .OR. k==kmax3)THEN
               IF (cyclic_z_pd) THEN
                  icbc_flag(ijk) = 'C--'
               ELSEIF (cyclic_z) THEN
                  icbc_flag(ijk) = 'c--'
               ELSE
                  icbc_flag(ijk) = 'W--'
               ENDIF
            ENDIF
         ENDIF

         IF(do_j)THEN
            IF(j==jmin3 .OR. j==jmin2 .OR. j==jmax2 .OR. j==jmax3)THEN
               IF (cyclic_y_pd) THEN
                  icbc_flag(ijk) = 'C--'
               ELSEIF (cyclic_y) THEN
                  icbc_flag(ijk) = 'c--'
               ELSE
                 icbc_flag(ijk) = 'W--'
               ENDIF
            ENDIF
         ENDIF

         IF(do_i)THEN
            IF(i==imin3 .OR. i==imin2 .OR. i==imax2 .OR. i==imax3)THEN
               IF (cyclic_x_pd) THEN
                  icbc_flag(ijk) = 'C--'
               ELSEIF (cyclic_x) THEN
                  icbc_flag(ijk) = 'c--'
               ELSE
                  icbc_flag(ijk) = 'W--'
               ENDIF
            ENDIF
            IF (i==1 .AND. cylindrical .AND. xmin==zero) &
               icbc_flag(ijk) = 'S--'
         ENDIF
! corner cells are wall cells
         IF ((i==imin3 .OR. i==imin2 .OR. i==imax2 .OR. i==imax3) .AND. &
             (j==jmin3 .OR. j==jmin2 .OR. j==jmax2 .OR. j==jmin3) .AND. &
             (k==kmin3 .OR. k==kmin2 .OR. k==kmax2 .OR. k==kmax3)) THEN
            IF (icbc_flag(ijk) /= 'S--') icbc_flag(ijk) = 'W--'
         ENDIF

      ENDDO ! end do loop (i=istart3, iend3)
      ENDDO ! end do loop (j=jstart3, jend3)
      ENDDO ! end do loop (k=kstart3, kend3)

      RETURN

      END SUBROUTINE init_icbc_flag



!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: CHECK_ICBC_FLAG                                         !
!  Author: P. Nicoletti                               Date: 10-DEC-91  !
!                                                                      !
!  Purpose: Verify that data was not given for undefined BC regions.   !
!  Note that the error message may be incomplete
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE check_icbc_flag


      use run, only: run_type

      use mpi_utility
      use sendrecv

      use error_manager
      use functions

      IMPLICIT NONE

      LOGICAL :: ERROR = .false.

      INTEGER :: I, J ,K, IER

      IF(run_type(1:3) /= 'NEW') RETURN



      CALL init_err_msg("CHECK_ICBC_FLAG")

! First check for any errors.
      DO k = kstart2, kend2
      DO j = jstart2, jend2
      DO i = istart2, iend2
         IF(icbc_flag(funijk(i,j,k)) == '   ') error = .true.
      ENDDO
      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, 1100) trim(ival(mype))
         CALL flush_err_msg(footer=.false.)

         DO k = kstart2, kend2
         DO j = jstart2, jend2
         DO i = istart2, iend2
            IF(icbc_flag(funijk(i,j,k)) == '   ') THEN
               WRITE(err_msg,1101) i, j, k
               CALL flush_err_msg(header=.false., footer=.false.)
            ENDIF

         ENDDO
         ENDDO
         ENDDO

         WRITE(err_msg, 1102)
         CALL flush_err_msg(header=.false., abort=.true.)

      ELSE
! If no erros, sync up the ghost cell layers.
         CALL send_recv(icbc_flag,2)
      ENDIF

! Clean up and return.
      CALL finl_err_msg

      RETURN

 1100 FORMAT('Error 1100 (PE ',a,') : No initial or boundary ',        &
         'condtions specified in','the following cells:',/             &
         '    I       J       K')

 1101 FORMAT(i5,3x,i5,3x,i5)

 1102 FORMAT('Please correct the mfix.dat file.')

      END SUBROUTINE check_icbc_flag



!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: SET_IC_FLAGS                                            !
!  Author: P. Nicoletti                               Date: 10-DEC-91  !
!                                                                      !
!  Purpose: Set the IC portions of the ICBC_Flag array.                !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE set_ic_flags

      use ic, only: ic_defined
      use ic, only: ic_type

      use ic, only: ic_i_w, ic_i_e
      use ic, only: ic_j_s, ic_j_n
      use ic, only: ic_k_b, ic_k_t

      use param, only: dimension_ic

      use sendrecv
      use mpi_utility
      use error_manager
      use functions

      IMPLICIT NONE

!-----------------------------------------------
! Local variables
!-----------------------------------------------
      INTEGER :: ICV
      INTEGER :: I, J, K, IJK

      CALL init_err_msg("SET_IC_FLAGS")


      ic_lp: DO icv=1, dimension_ic

         IF(.NOT.ic_defined(icv)) cycle ic_lp

! Skip checks for PATCH restarts.
         IF (ic_type(icv) == 'PATCH') cycle ic_lp

!  Set ICBC flag
         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)
            IF(.NOT.is_on_mype_plus2layers(i,j,k)) cycle
            IF(dead_cell_at(i,j,k)) cycle
            ijk = funijk(i,j,k)
            WRITE(icbc_flag(ijk)(1:3),"('.',I2.2)") mod(icv,100)
         ENDDO
         ENDDO
         ENDDO


      ENDDO ic_lp

! Update the ICBC flag on ghost cells.
      CALL send_recv(icbc_flag, 2)


! Clean up and return.
      CALL finl_err_msg

      RETURN

      END SUBROUTINE set_ic_flags

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: SET_BC_FLAGS_WALL                                       !
!  Author: P. Nicoletti                               Date: 10-DEC-91  !
!                                                                      !
!  Purpose: Find and validate i, j, k locations for walls BC's         !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE set_bc_flags_wall

      USE param
      USE param1
      USE geometry
      USE fldvar
      USE physprop
      USE bc
      USE indices
      USE funits
      USE compar
      USE sendrecv
      USE functions

      use error_manager

      IMPLICIT NONE

!-----------------------------------------------
! Local variables
!-----------------------------------------------
! loop/variable indices
      INTEGER :: I , J , K , IJK
! loop index
      INTEGER :: BCV

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

      CALL init_err_msg("SET_BC_FLAGS_WALL")

! Set the wall flags.
      DO bcv=1, dimension_bc
         IF(.NOT.bc_defined(bcv)) cycle

         IF(bc_type_enum(bcv)==free_slip_wall .OR. &
            bc_type_enum(bcv)==no_slip_wall   .OR. &
            bc_type_enum(bcv)==par_slip_wall) THEN

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

               IF(.NOT.is_on_mype_plus2layers(i,j,k)) cycle
               IF(dead_cell_at(i,j,k)) cycle

               ijk = funijk(i,j,k)

               SELECT CASE (bc_type_enum(bcv))
               CASE(free_slip_wall); icbc_flag(ijk)(1:1) = 'S'
               CASE(no_slip_wall);   icbc_flag(ijk)(1:1) = 'W'
               CASE(par_slip_wall);  icbc_flag(ijk)(1:1) = 's'
               END SELECT
               WRITE (icbc_flag(ijk)(2:3),"(I2.2)") mod(bcv,100)
            ENDDO
            ENDDO
            ENDDO

         ENDIF
      ENDDO

      CALL send_recv(icbc_flag,2)

      CALL finl_err_msg

      RETURN
      END SUBROUTINE set_bc_flags_wall



!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: SET_BC_FLAGS_FLOW                                       !
!  Author: P. Nicoletti                               Date: 10-DEC-91  !
!                                                                      !
!  Purpose: Find and validate i, j, k locations for flow BC's. Also    !
!           set value of bc_plane for flow BC's.                       !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE set_bc_flags_flow

      USE param
      USE param1
      USE geometry
      USE fldvar
      USE physprop
      USE bc
      USE indices
      USE funits
      USE compar
      USE sendrecv

      use mpi_utility
      use sendrecv
      use functions

      use error_manager

      IMPLICIT NONE

! loop/variable indices
      INTEGER :: BCV, I, J, K, IJK

      INTEGER :: IER

! error indicator
      LOGICAL :: ERROR
! surface indictors
      LOGICAL :: X_CONSTANT, Y_CONSTANT, Z_CONSTANT

      CALL init_err_msg("SET_BC_FLAGS_FLOW")


! FIND THE FLOW SURFACES
      error = .false.

      DO bcv = 1, dimension_bc

         IF(.NOT.bc_defined(bcv)) cycle

         IF(bc_type_enum(bcv)==mass_inflow  .OR. &
            bc_type_enum(bcv)==mass_outflow .OR. &
            bc_type_enum(bcv)==p_inflow     .OR. &
            bc_type_enum(bcv)==p_outflow    .OR. &
            bc_type_enum(bcv)==outflow) THEN

            x_constant = (bc_x_w(bcv) == bc_x_e(bcv))
            y_constant = (bc_y_s(bcv) == bc_y_n(bcv))
            z_constant = (bc_z_b(bcv) == bc_z_t(bcv))

            IF(x_constant .AND. bc_x_w(bcv)/=undefined)                &
               CALL mod_bc_i(bcv)

            IF(y_constant .AND. bc_y_s(bcv)/=undefined)                &
               CALL mod_bc_j(bcv)

            IF(z_constant .AND. bc_z_b(bcv)/=undefined)                &
               CALL mod_bc_k(bcv)

! Extend the boundaries for cyclic implementation
            IF(bc_i_w(bcv) == 2 .AND. bc_i_e(bcv) == (imax2 - 1) .AND. &
               cyclic_x .AND. nodesi > 1) THEN
                   bc_i_w(bcv) = 1
                   bc_i_e(bcv) = imax2
            ENDIF
            IF(bc_j_s(bcv) == 2 .AND. bc_j_n(bcv) == (jmax2 - 1) .AND. &
               cyclic_y .AND. nodesj > 1) THEN
               bc_j_s(bcv) = 1
               bc_j_n(bcv) = jmax2
            ENDIF
            IF(bc_k_b(bcv) == 2 .AND. bc_k_t(bcv) == (kmax2 - 1) .AND. &
               cyclic_z .AND. nodesk > 1) THEN
               bc_k_b(bcv) = 1
               bc_k_t(bcv) = kmax2
            ENDIF

! Set add the BC to the ICBC_FLAG. If a "non-wall" BC is found, then flag
! this as an error. The next triple-loop will take care of reporting the
! error.
            error = .false.
            DO k = bc_k_b(bcv), bc_k_t(bcv)
            DO j = bc_j_s(bcv), bc_j_n(bcv)
            DO i = bc_i_w(bcv), bc_i_e(bcv)

               IF(.NOT.is_on_mype_plus2layers(i,j,k)) cycle
               IF(dead_cell_at(i,j,k)) cycle

               ijk = funijk(i,j,k)

! Verify that the FLOW BC is overwriting a wall.
               IF(wall_icbc_flag(ijk)) THEN

                  SELECT CASE (bc_type_enum(bcv))
                  CASE (p_outflow);    icbc_flag(ijk)(1:1) = 'P'
                  CASE (mass_inflow);  icbc_flag(ijk)(1:1) = 'I'
                  CASE (mass_outflow); icbc_flag(ijk)(1:1) = 'O'
                  CASE (outflow);      icbc_flag(ijk)(1:1) = 'o'
                  CASE (p_inflow);     icbc_flag(ijk)(1:1) = 'p'
                  END SELECT

                  WRITE(icbc_flag(ijk)(2:3),"(I2.2)") mod(bcv,100)

               ELSE
                  error = .true.
               ENDIF

            ENDDO
            ENDDO
            ENDDO

! Sync the error flag over all ranks.
            CALL global_all_or(error)

! Report errors and exit.
            IF(error)THEN

               CALL open_pe_log(ier)

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

 1200 FORMAT('Error 1200: Boundary condition ',i3,' overlaps with ',&
         'another BC.',2/7x,'I',7x,'J',7x,'K',3x,'ICBC')

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

                  IF(.NOT.is_on_mype_plus2layers(i,j,k)) cycle
                  IF(dead_cell_at(i,j,k)) cycle

                  ijk = funijk(i,j,k)

! Verify that the FLOW BC is overwriting a wall.
                  IF(.NOT.wall_icbc_flag(ijk)) THEN
                     WRITE(err_msg, 1201) i,j,k, icbc_flag(ijk)
                     CALL flush_err_msg(header=.false., footer=.false.)
                  ENDIF

 1201 FORMAT(1x,3(2x,i6),3x,a3)

               ENDDO
               ENDDO
               ENDDO

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

            ENDIF ! IF(ERROR)
         ENDIF ! IF(not a wall BC)
      ENDDO ! BC Loop

! Sync the ICBC flag across ghost layers
      CALL send_recv(icbc_flag,2)

      CALL finl_err_msg

      RETURN
      END SUBROUTINE set_bc_flags_flow