set_increments3.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: SET_INCREMENTS3                                         !
!  Author: M. Syamlal, W. Rogers                      Date: 10-DEC-91  !
!                                                                      !
!  Purpose: The purpose of this module is to create increments to be   !
!           stored in the array STORE_INCREMENT which will be added    !
!           to cell index ijk to find the effective indices of its     !
!           neighbors. These increments are found using the 'class'    !
!           of cell ijk. The class is determined based on the          !
!           neighboring cell type, i.e. wall or fluid.                 !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE set_increments3

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

! Module procedures
!---------------------------------------------------------------------//
      use mpi_utility, only: global_all_sum
      use error_manager
      use function3
      use functions

      IMPLICIT NONE

! Local Variables:
!---------------------------------------------------------------------//
! Indices
      INTEGER :: I, J, K, IJK
      INTEGER :: IMJK, IPJK, IJKW, IJKE  ! I+, I-, east/west
      INTEGER :: IJMK, IJPK, IJKS, IJKN  ! J+, J-, north/south
      INTEGER :: IJKM, IJKP, IJKB, IJKT  ! K+, K-, top/bottom
! DO-loop index, ranges from 1 to ICLASS
      INTEGER :: IC
! Index denoting cell class
      INTEGER :: ICLASS
! Array of sum of increments to make the class determination faster.
      INTEGER :: DENOTE_CLASS(max_class)
! Flag for using the 'real' I/J/K value (not cyclic.)
      LOGICAL :: SHIFT
!......................................................................!


! Initialize the error manager.
      CALL init_err_msg("SET_INCREMENTS3")

! Initialize the default values to Undefined_I

      ip1_3(:) = undefined_i
      im1_3(:) = undefined_i
      jp1_3(:) = undefined_i
      jm1_3(:) = undefined_i
      kp1_3(:) = undefined_i
      km1_3(:) = undefined_i

      DO i = istart4, iend4

         shift = .NOT.(i==imin4 .OR. i==imin3 .OR. i==imin2 .OR. &
                       i==imax4 .OR. i==imax3 .OR. i==imax2)

         IF(cyclic_x .AND. nodesi.EQ.1 .AND. do_i .AND. shift) THEN
            ip1_3(i) = imap_c(imap_c(i)+1)
            im1_3(i) = imap_c(imap_c(i)-1)
         ELSE
            im1_3(i) = max(istart4,i - 1)
            ip1_3(i) = min(iend4,i + 1)
         ENDIF
      ENDDO


      DO j = jstart4, jend4

         shift = .NOT.(j==jmin4 .OR. j==jmin3 .OR. j==jmin2 .OR. &
                       j==jmax4 .OR. j==jmax3 .OR. j==jmax2)

         IF(cyclic_y .AND. nodesj.EQ.1 .AND. do_j .AND. shift) THEN
            jp1_3(j) = jmap_c(jmap_c(j)+1)
            jm1_3(j) = jmap_c(jmap_c(j)-1)
         ELSE
            jm1_3(j) = max(jstart4,j - 1)
            jp1_3(j) = min(jend4,j + 1)
         ENDIF
      ENDDO


      DO k = kstart4, kend4

         shift = .NOT.(k==kmin4 .OR. k==kmin3 .OR. k==kmin2 .OR. &
                       k==kmax4 .OR. k==kmax3 .OR. k==kmax2)

         IF(cyclic_z .AND. nodesk.EQ.1 .AND. do_k .AND. shift) THEN
            kp1_3(k) = kmap_c(kmap_c(k)+1)
            km1_3(k) = kmap_c(kmap_c(k)-1)
         ELSE
            km1_3(k) = max(kstart4,k - 1)
            kp1_3(k) = min(kend4,k + 1)
         ENDIF
      ENDDO

!     Loop over all cells
      DO k = kstart4, kend4
      DO j = jstart4, jend4
      DO i = istart4, iend4
         ijk = funijk3(i,j,k)

         i3_of(ijk) = i
         j3_of(ijk) = j
         k3_of(ijk) = k
      ENDDO
      ENDDO
      ENDDO

! Initialize the number of cell classes
      iclass = 0

! Loop over all cells (minus the ghost layers)
      DO k = kstart4, kend4
      DO j = jstart4, jend4
      l100: DO i = istart4, iend4

         ijk = funijk3(i,j,k)

!  Find the the effective cell-center indices for all neighbor cells
         CALL set_index1a3 (i, j, k, ijk, imjk, ipjk, ijmk, ijpk, ijkm,&
            ijkp, ijkw, ijke, ijks, ijkn, ijkb, ijkt)

! Increment the ICLASS counter
         iclass = iclass + 1
         IF(iclass > max_class) THEN
            WRITE(err_msg, 1200) trim(ival(max_class))
            CALL flush_err_msg(abort=.true.)
         ENDIF

 1200 FORMAT('Error 1200: The number of classes has exceeded the ',    &
         'maximum: ',a,/'Increase the MAX_CLASS parameter in param1',  &
         '_mod.f and recompile.')

         increment3_for_im(iclass) = imjk - ijk
         increment3_for_ip(iclass) = ipjk - ijk
         increment3_for_jm(iclass) = ijmk - ijk
         increment3_for_jp(iclass) = ijpk - ijk
         increment3_for_km(iclass) = ijkm - ijk
         increment3_for_kp(iclass) = ijkp - ijk

         denote_class(iclass) =  &
            increment3_for_im(iclass) + increment3_for_ip(iclass) + &
            increment3_for_jm(iclass) + increment3_for_jp(iclass) + &
            increment3_for_km(iclass) + increment3_for_kp(iclass)

            cell_class3(ijk) = iclass

! Place the cell in a class based on its DENOTE_CLASS(ICLASS) value
! Loop over previous and present classes
         DO ic = 1, iclass - 1

            IF (denote_class(iclass) == denote_class(ic)) THEN
               IF(increment3_for_im(iclass)/=increment3_for_im(ic))cycle
               IF(increment3_for_ip(iclass)/=increment3_for_ip(ic))cycle
               IF(increment3_for_jm(iclass)/=increment3_for_jm(ic))cycle
               IF(increment3_for_jp(iclass)/=increment3_for_jp(ic))cycle
               IF(increment3_for_km(iclass)/=increment3_for_km(ic))cycle
               IF(increment3_for_kp(iclass)/=increment3_for_kp(ic))cycle
               cell_class3(ijk) = ic
               iclass = iclass - 1
               cycle  l100 ! Go to next cell
            ENDIF
         END DO

      END DO l100
      END DO
      END DO

      CALL finl_err_msg

      RETURN
      END SUBROUTINE set_increments3