RFLO_ModDegenerateCornEdge.F90

Go to the documentation of this file.

! *********************************************************************
! * Rocstar Simulation Suite                                          *
! * Copyright@2015, Illinois Rocstar LLC. All rights reserved.        *
! *                                                                   *
! * Illinois Rocstar LLC                                              *
! * Champaign, IL                                                     *
! * www.illinoisrocstar.com                                           *
! * sales@illinoisrocstar.com                                         *
! *                                                                   *
! * License: See LICENSE file in top level of distribution package or *
! * http://opensource.org/licenses/NCSA                               *
! *********************************************************************
! *********************************************************************
! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,   *
! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES   *
! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND          *
! * NONINFRINGEMENT.  IN NO EVENT SHALL THE CONTRIBUTORS OR           *
! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER       *
! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,   *
! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE    *
! * USE OR OTHER DEALINGS WITH THE SOFTWARE.                          *
! *********************************************************************
! ******************************************************************************
!
! Purpose: Suite pertaining degenerate edges/corners routines.
!
! Description: None.
!
! Notes: None.
!
! ******************************************************************************
!
! $Id: RFLO_ModDegenerateCornEdge.F90,v 1.3 2008/12/06 08:44:15 mtcampbe Exp $
!
! Copyright: (c) 2004 by the University of Illinois
!
! ******************************************************************************

MODULE rflo_moddegeneratecornedge

  USE modglobal, ONLY    : t_global 
  USE moddatastruct, ONLY: t_region, t_level
  USE modbndpatch, ONLY  : t_patch
  USE modgrid, ONLY      : t_grid
  USE modparameters
  USE moddatatypes
  USE moderror
  USE modmpi
  
  IMPLICIT NONE

  PRIVATE
  PUBLIC :: rflo_finddegeneratcell, &
            rflo_markdegeneratvert, &
            rflo_writedegeneratec
 
! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
  CHARACTER(CHRLEN) :: RCSIdentString = & 
    '$RCSfile: RFLO_ModDegenerateCornEdge.F90,v $ $Revision: 1.3 $'        
             
! ******************************************************************************
! Routines
! ******************************************************************************

  CONTAINS

!******************************************************************************
!
! Purpose: given the indices of a dummy cell, find out if this cell is
!          degenerative and what level of degeration.
!
! Description: at first call (handleCorn=0), find if the test edge lays within
!              a patch of the same region, at second call (handleCorn=1) find
!              if the test corner lays within an edge or a patch of the same 
!              region.
!
! Input: regions    = dimensions and topology of all regions
!        handleCorn = treat corner (1) or edge (0)
!        icount     = i^th component of corner (handle=1) or edge (handle=0)
!        iReg       = current region
!        iLev       = current grid level
!        iRegTest   = region number of the test dimmy cell
!        icellTest  = index of the test dimmy cell
!        i/j/kTest  = indices of the test dummy cell
!
! Output: global%degenrtEc = .true. if the test cell is degenerative
!         level%edgeCell(icount)%degenrt   = level of edge degeneration
!         level%cornerCell(icount)%degenrt = level of level degeneration
!
! Notes: type of degenerative edge   = 0 (none)
!                                    = 1 (edge within patch)
!                                         when < 4 int. cells meet at the edge 
!                                    < 0 (detached from adjacent patches)
!                                         when > 4 int. cells meet at the edge 
!        type of degenerative corner = 0 (none)
!                                    = 1 (corner within edge)
!                                         when 6 int. cells meet at the corner 
!                                    = 2 (corner within patch)
!                                         when 4 int. cells meet at the corner 
!                                    < 0 (detached from adjacent edges)
!                                         when >8 int.cells meet at the corner 
!
!        Assignment of negative level (disconnected edge/corners) happens 
!        outside this routine.
!
!******************************************************************************

SUBROUTINE rflo_finddegeneratcell( regions,handleCorn,icount,iReg,iLev, &
                                   iregtest,icelltest,itest,jtest,ktest )

  USE modinterfaces, ONLY : rflo_getpatchindices, rflo_getedgecellsindices
  IMPLICIT NONE

! ... parameters
  INTEGER :: handlecorn, icount, ireg, ilev
  INTEGER :: iregtest, icelltest, itest, jtest, ktest

  TYPE(t_region), POINTER :: regions(:)

! ... loop variables
  INTEGER :: ipatch, iedge, i, j, k

! ... local variables
  TYPE(t_global), POINTER :: global
  TYPE(t_level), POINTER  :: level
  TYPE(t_patch), POINTER  :: patch, patchsrc

  INTEGER :: iregsrc, ipatchsrc, bctype, lbound, jreg, jcell
  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, ijk, nshift
  INTEGER :: ibegsrc, iendsrc, jbegsrc, jendsrc, kbegsrc, kendsrc


!******************************************************************************

  global => regions(1)%global

  CALL registerfunction( global,'RFLO_FindDegeratCell',&
       'RFLO_ModDegenerateCornEdge.F90' )

! get pointers ----------------------------------------------------------------

  level => regions(ireg)%levels(ilev)

! check if input edge or corner within patch dummy layers ---------------------

  DO ipatch=1,regions(ireg)%nPatches
    patch => regions(ireg)%levels(ilev)%patches(ipatch)
    bctype = patch%bcType
    lbound = patch%lbound

    IF ((bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) .OR. &
        (bctype>=bc_tra_peri   .AND. bctype<=bc_tra_peri  +bc_range) .OR. &
        (bctype>=bc_rot_peri   .AND. bctype<=bc_rot_peri  +bc_range)) THEN

      iregsrc   = patch%srcRegion

      IF (iregtest == iregsrc) THEN
        ipatchsrc = patch%srcPatch
        patchsrc => regions(iregsrc)%levels(ilev)%patches(ipatchsrc)

        CALL rflo_getpatchindices( regions(iregsrc),patchsrc,ilev,ibegsrc, &
                                   iendsrc,jbegsrc,jendsrc,kbegsrc,kendsrc )
        nshift = regions(iregsrc)%nDumCells-1
        IF (patchsrc%lbound==1) iendsrc = iendsrc+nshift
        IF (patchsrc%lbound==2) ibegsrc = ibegsrc-nshift
        IF (patchsrc%lbound==3) jendsrc = jendsrc+nshift
        IF (patchsrc%lbound==4) jbegsrc = jbegsrc-nshift
        IF (patchsrc%lbound==5) kendsrc = kendsrc+nshift
        IF (patchsrc%lbound==6) kbegsrc = kbegsrc-nshift

        IF ((itest>=ibegsrc .AND. itest<=iendsrc) .AND. &
            (jtest>=jbegsrc .AND. jtest<=jendsrc) .AND. &
            (ktest>=kbegsrc .AND. ktest<=kendsrc)) THEN
          IF (handlecorn==0) THEN

! --------- edge within patch
            level%edgeCells(icount)%degenrt = degenerat_edge_in_patch
          ELSE

! --------- corner within patch
            level%cornerCells(icount)%degenrt = degenerat_corn_in_patch
          ENDIF  ! handle
          global%degenrtEc = .true.

        ENDIF    ! i,j,kTest
      ENDIF      ! iRegTest
    ENDIF        ! bcType
  ENDDO          ! iPatch

! check if input corner within an edge ----------------------------------------

  IF (handlecorn==1) THEN

    DO iedge=1,12
      IF (level%edgeCells(iedge)%interact) THEN
        CALL rflo_getedgecellsindices( regions(ireg),ilev,iedge, &
                                       ibeg,iend,jbeg,jend,kbeg,kend )
        ijk = 0
        DO k=kbeg,kend
          DO j=jbeg,jend
            DO i=ibeg,iend
              ijk = ijk + 1
              jcell = level%edgeCells(iedge)%cells(ijk)%srcCell
              jreg  = level%edgeCells(iedge)%cells(ijk)%srcRegion
              IF (iregtest==jreg .AND. icelltest==jcell) THEN

! ------------- corner within edge
                level%cornerCells(icount)%degenrt = degenerat_corn_in_edge
                global%degenrtEc = .true.
                goto 888
              ENDIF
            ENDDO  ! i
          ENDDO    ! j
        ENDDO      ! k
888     CONTINUE

      ENDIF      ! interact
    ENDDO        ! iedge
  ENDIF          ! handleCorn

! finalize --------------------------------------------------------------------

  CALL deregisterfunction( global )

END SUBROUTINE rflo_finddegeneratcell


!******************************************************************************
!
! Purpose: flag degenerate vertices.
!
! Description: grid%ijkDgen = 0 for normal vertices and 1 for degenerate 
!
! Input: regions = dimensions and topology of all regions.
!
! Output: regions = grid%ijkDgen
!
! Notes: none.
!
!******************************************************************************

SUBROUTINE rflo_markdegeneratvert( regions )

  USE modinterfaces, ONLY : rflo_getdimensphysnodes, rflo_getnodeoffset
  IMPLICIT NONE

#include "Indexing.h"

! ... parameters
  TYPE(t_region), POINTER :: regions(:)

! ... loop variables
  INTEGER :: ireg, ilev, iedge, icorner, i, j, k

! ... local variables
  INTEGER :: ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend, inoff, ijnoff
  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, ijk, errorflag

  INTEGER, POINTER :: idgen(:)
  TYPE(t_global), POINTER :: global
  TYPE(t_level), POINTER  :: level

!******************************************************************************

  global => regions(1)%global

  CALL registerfunction( global,'RFLO_MarkDegeneratVert',&
       'RFLO_ModDegenerateCornEdge.F90' )

! find degenerate vertices ====================================================

  DO ireg=1,global%nRegions
    IF (regions(ireg)%procid==global%myProcid .AND. &   ! region active and
        regions(ireg)%active==active) THEN              ! on my processor

      DO ilev=1,regions(ireg)%nGridLevels
        level => regions(ireg)%levels(ilev)
        idgen => regions(ireg)%levels(ilev)%grid%ijkDgen
        idgen =  0

        CALL rflo_getdimensphysnodes( regions(ireg),ilev,ipnbeg,ipnend, &
                                    jpnbeg,jpnend,kpnbeg,kpnend )
        CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )

! ----- edge vertices ---------------------------------------------------------

        DO iedge=1,12

          SELECT CASE (iedge)
          CASE (1)
            ibeg = ipnbeg
            iend = ipnbeg
            jbeg = jpnbeg
            jend = jpnbeg
            kbeg = kpnbeg
            kend = kpnend
          CASE (2)
            ibeg = ipnbeg
            iend = ipnbeg
            jbeg = jpnbeg
            jend = jpnend
            kbeg = kpnend
            kend = kpnend
          CASE (3)
            ibeg = ipnbeg
            iend = ipnbeg
            jbeg = jpnend
            jend = jpnend
            kbeg = kpnbeg
            kend = kpnend
          CASE (4)
            ibeg = ipnbeg
            iend = ipnbeg
            jbeg = jpnbeg
            jend = jpnend
            kbeg = kpnbeg
            kend = kpnbeg
          CASE (5)
            ibeg = ipnend
            iend = ipnend
            jbeg = jpnbeg
            jend = jpnbeg
            kbeg = kpnbeg
            kend = kpnend
          CASE (6)
            ibeg = ipnend
            iend = ipnend
            jbeg = jpnbeg
            jend = jpnend
            kbeg = kpnend
            kend = kpnend
          CASE (7)
            ibeg = ipnend
            iend = ipnend
            jbeg = jpnend
            jend = jpnend
            kbeg = kpnbeg
            kend = kpnend
          CASE (8)
            ibeg = ipnend
            iend = ipnend
            jbeg = jpnbeg
            jend = jpnend
            kbeg = kpnbeg
            kend = kpnbeg
          CASE (9)
            ibeg = ipnbeg
            iend = ipnend
            jbeg = jpnbeg
            jend = jpnbeg
            kbeg = kpnbeg
            kend = kpnbeg
          CASE (10)
            ibeg = ipnbeg
            iend = ipnend
            jbeg = jpnbeg
            jend = jpnbeg
            kbeg = kpnend
            kend = kpnend
          CASE (11)
            ibeg = ipnbeg
            iend = ipnend
            jbeg = jpnend
            jend = jpnend
            kbeg = kpnend
            kend = kpnend
          CASE (12)
            ibeg = ipnbeg
            iend = ipnend
            jbeg = jpnend
            jend = jpnend
            kbeg = kpnbeg
            kend = kpnbeg
          END SELECT

          IF (level%edgeCells(iedge)%degenrt /= degenerat_none) THEN
            DO k=kbeg,kend
              DO j=jbeg,jend
                DO i=ibeg,iend
                  ijk = indijk(i  ,j  ,k  ,inoff,ijnoff)
                  idgen(ijk) = 1
                ENDDO
              ENDDO
            ENDDO
          ENDIF  ! degenrt
        ENDDO    ! iedge

! ----- corner cells ----------------------------------------------------------

        DO icorner=1,8
          SELECT CASE (icorner)
          CASE (1)
            ibeg = ipnbeg
            iend = ipnbeg
            jbeg = jpnbeg
            jend = jpnbeg
            kbeg = kpnbeg
            kend = kpnbeg
          CASE (2)
            ibeg = ipnbeg
            iend = ipnbeg
            jbeg = jpnbeg
            jend = jpnbeg
            kbeg = kpnend
            kend = kpnend
          CASE (3)
            ibeg = ipnbeg
            iend = ipnbeg
            jbeg = jpnend
            jend = jpnend
            kbeg = kpnend
            kend = kpnend
          CASE (4)
            ibeg = ipnbeg
            iend = ipnbeg
            jbeg = jpnend
            jend = jpnend
            kbeg = kpnbeg
            kend = kpnbeg
          CASE (5)
            ibeg = ipnend
            iend = ipnend
            jbeg = jpnbeg
            jend = jpnbeg
            kbeg = kpnbeg
            kend = kpnbeg
          CASE (6)
            ibeg = ipnend
            iend = ipnend
            jbeg = jpnbeg
            jend = jpnbeg
            kbeg = kpnend
            kend = kpnend
          CASE (7)
            ibeg = ipnend
            iend = ipnend
            jbeg = jpnend
            jend = jpnend
            kbeg = kpnend
            kend = kpnend
          CASE (8)
            ibeg = ipnend
            iend = ipnend
            jbeg = jpnend
            jend = jpnend
            kbeg = kpnbeg
            kend = kpnbeg
          END SELECT

          IF (level%cornerCells(icorner)%degenrt /= degenerat_none) THEN
            DO k=kbeg,kend
              DO j=jbeg,jend
                DO i=ibeg,iend
                  ijk = indijk(i  ,j  ,k  ,inoff,ijnoff)
                  idgen(ijk) = 1
                ENDDO
              ENDDO
            ENDDO
          ENDIF  ! degenrt
        ENDDO    ! icorner

      ENDDO      ! iLev
    ENDIF        ! myProcid
  ENDDO          ! iReg

! finalize ====================================================================

  CALL deregisterfunction( global )

END SUBROUTINE rflo_markdegeneratvert


! ******************************************************************************
!
! Purpose: write degenerated edges and corners (if exist) in each region 
!          into a file
!
! Description: only MASTERPROC write the information as all edge and corner
!              data are available in this processor.
!
! Notes: none.
!
! ******************************************************************************

SUBROUTINE rflo_writedegeneratec( regions )

  IMPLICIT NONE

! ... parameters
  TYPE(t_region), POINTER :: regions(:)

! ... loop variables
  INTEGER :: ireg, iedge, icorner
   
! ... local variables
  CHARACTER(CHRLEN) :: ifilename
  TYPE(t_global), POINTER :: global
  TYPE(t_level), POINTER  :: level

  INTEGER :: ilev, errorflag, ifile
  
! ******************************************************************************

  global => regions(1)%global

  CALL registerfunction(global,'RFLO_WriteDegeneratEC',&
       'RFLO_ModDegenerateCornEdge.F90')

! start ------------------------------------------------------------------------

  ifile = if_degenrt

  WRITE(ifilename,'(A)') &
        trim(global%outDir)//trim(global%casename)//'.degec'

  OPEN(ifile,file=ifilename,form="FORMATTED",status="UNKNOWN",iostat=errorflag)   
  global%error = errorflag        

  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_file_open,&
         __line__,ifilename)
  END IF ! global%error

! header and general information ---------------------------------------------

  WRITE(ifile,1005)' ROCFLO degenerated edges and corners'  

  WRITE(ifile,1000)

! print degenerated edge and corner per region (if exist) --------------------

  DO ireg=1,global%nRegions

    ilev  =  regions(ireg)%currLevel
    level => regions(ireg)%levels(ilev)

    WRITE(ifile,1025) ireg
    WRITE(ifile,1005) '  Edge #       Degeneration-type' 
      
    DO iedge = 1,12
      IF (level%edgeCells(iedge)%degenrt /= degenerat_none) &
        WRITE(ifile,1015) iedge, level%edgeCells(iedge)%degenrt
    ENDDO          

    WRITE(ifile,1005) '  Corner #     Degeneration-type' 
      
    DO icorner = 1,8
      IF (level%cornerCells(icorner)%degenrt /= degenerat_none) &
        WRITE(ifile,1015) icorner, level%cornerCells(icorner)%degenrt
    ENDDO          

    WRITE(ifile,1000)
  ENDDO  ! iReg

! print legend explaining meaning of degeration values ----------------------

  WRITE(ifile,1005)' Edge degeneration type:'  
  WRITE(ifile,1030)'    1 = EDGE IN PATCH (< 4 interior cells meet at the edge)'  
  WRITE(ifile,1030)'   -1 = EDGE DETACHED (> 4 interior cells meet at the edge)'  

  WRITE(ifile,1005)' Corner degeneration type:'
  WRITE(ifile,1030)'    1 = CORNER IN EDGE  (  6 interior cells meet at the corner)'  
  WRITE(ifile,1030)'    2 = CORNER IN PATCH (  4 interior cells meet at the corner)'  
  WRITE(ifile,1030)'   -1 = CORNER DETACHED (> 8 interior cells meet at the corner)'  

! close file -------------------------------------------------------------------

  CLOSE(ifile,iostat=errorflag)
  global%error = errorflag      
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_file_close,&
         __line__,ifilename)
  END IF

! finalize ---------------------------------------------------------------------

  CALL deregisterfunction( global )

1000 FORMAT(/,1x,40('-'))
1005 FORMAT(/,a)
1015 FORMAT(i8,8x,i8)
1025 FORMAT('   Region ',i6,':')
1030 FORMAT(a)
1035 FORMAT(/,1x,40('-'),/)
  
END SUBROUTINE rflo_writedegeneratec

! ******************************************************************************
! End
! ******************************************************************************
  
END MODULE rflo_moddegeneratecornedge

! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLO_ModDegenerateCornEdge.F90,v $
! Revision 1.3  2008/12/06 08:44:15  mtcampbe
! Updated license.
!
! Revision 1.2  2008/11/19 22:17:27  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.1  2005/11/11 07:24:58  wasistho
! initial import RFLO_ModDegenerateCornEdge
!
!
! ******************************************************************************