TFLU_ConvertFlo2FluMesh.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: collect sizes of required arrays and compute unstructured grid
!          and its connectivity from structured grid in the current region
!
! Description: collect array sizes at first call, i.e. when iFlag=0.
!              At second call (iFlag=1) compute the x,y,z coordinates of the
!              the unstructured vertices and obtain connectivity for all
!              all hexes in the whole region. The connectivity of quads and
!              vertices at boundary patches are computed in subroutine
!              ConvertFlo2FluPatch.
!
! Input: iFlag      = flag to determine the type of processing:
!                     0 for collection of array sizes
!                     1 for computation of unstructured grid and connectivity
!        iReg       = region number
!        regions    = data for all regions
!
! Output: global%tofluNPatches, NVerts, NHexs, NbfMax, NbnMax (iFlag=0)
!         grid%tofluLoc2g, global%tofluLoc2g, tofluXyz, tofluHex2v (iFlag=1)
!         global%tofluNFaces (iFlag=0), NEdges (iFlag=0 and 1)
!
! Notes: grid%tofluLoc2g is not deallocated in loop over regions in the main
!        main code ROCFLO_toFlu (unlike grid%xyz), as connectivity in previous 
!        regions are needed by the current region. This is done for simplicity
!        in coding, otherwise additional surface arrays for connectivity at
!        patches of previous regions are required including a copy procedure
!        to these arrays. The memory penalty due to this unallocated arrays
!        is believed to be insubstantial, as the values stored are integer.
!
!******************************************************************************
!
! $Id: TFLU_ConvertFlo2FluMesh.F90,v 1.5 2008/12/06 08:44:53 mtcampbe Exp $
!
! Copyright: (c) 2001 by the University of Illinois
!
!******************************************************************************

SUBROUTINE convertflo2flumesh( iFlag,iReg,regions )

  USE moddatatypes
  USE moderror
  USE moddatastruct, ONLY : t_region
  USE modglobal, ONLY     : t_global
  USE modgrid, ONLY       : t_grid
  USE modbndpatch, ONLY   : t_patch
  USE tflu_modinterfaces, ONLY : rflo_getdimensphysnodes, &
         rflo_getdimensdummynodes, rflo_getnodeoffset, rflo_getpatchindices, &
         rflo_getpatchindicesnodes, rflo_getpatchdirection, &
         rflo_getpatchmapping, rflo_readgridregion 
                               
  USE modparameters
  IMPLICIT NONE

#include "Indexing.h"

! ... parameters
  INTEGER :: iflag, ireg
  TYPE(t_region), POINTER :: regions(:)

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

! ... local variables
  TYPE(t_global), POINTER :: global
  TYPE(t_grid) , POINTER  :: grid, gridsrc
  TYPE(t_patch) , POINTER :: patch, patchsrc

  INTEGER :: ilev, lbound, bctype, inoff, ijnoff, ijkn, ibn, ien, found(6)
  INTEGER :: ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend
  INTEGER :: idnbeg, idnend, jdnbeg, jdnend, kdnbeg, kdnend
  INTEGER :: iaddb, jaddb, kaddb, iadde, jadde, kadde, madd
  INTEGER :: idir, jdir, kdir, idirsrc, jdirsrc, kdirsrc
  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, dims(2), errorflag
  INTEGER :: ibegsrc, iendsrc, jbegsrc, jendsrc, kbegsrc, kendsrc 
  INTEGER :: is, js, ks, l1srcdir, l2srcdir, mapmat(3,4)
  INTEGER :: h, iregsrc, ilevsrc, lbs, l1bs, l1es, l2bs, l2es
  LOGICAL :: align

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

  global => regions(1)%global
  CALL registerfunction( global,'ConvertFlo2FluMesh',&
  'TFLU_ConvertFlo2FluMesh.F90' )

! collect sizes and check bnd patches (iFlag=0) -------------------------------
! memory allocations and read grid (iFlag=1)
  
! allocate memory for grid

  ilev = regions(ireg)%currLevel

  CALL rflo_getdimensphysnodes( regions(ireg),ilev,ipnbeg,ipnend, &
                                jpnbeg,jpnend,kpnbeg,kpnend )
  CALL rflo_getdimensdummynodes( regions(ireg),ilev,idnbeg,idnend, &
                                 jdnbeg,jdnend,kdnbeg,kdnend )
  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )

! detect any region face with mixed connecting and non-conn. bc.

  iaddb = 0
  jaddb = 0
  kaddb = 0
  iadde = 0
  jadde = 0
  kadde = 0

  found(:) = 0

  DO ipatch=1,regions(ireg)%nPatches

    patch   => regions(ireg)%levels(ilev)%patches(ipatch)
    lbound  =  patch%lbound
    bctype  =  patch%bcType
    iregsrc =  patch%srcRegion

! - note, current algorithm only holds for connecting bc applied on whole face
!   of a region, not partially or mixed with other bcType

    CALL rflo_getpatchindicesnodes( regions(ireg),patch,ilev, &
                                    ibeg,iend,jbeg,jend,kbeg,kend )

    IF ((bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) .AND. &
        iregsrc < ireg) THEN
      IF (lbound==1) iaddb =  1
      IF (lbound==2) iadde = -1
      IF (lbound==3) jaddb =  1
      IF (lbound==4) jadde = -1
      IF (lbound==5) kaddb =  1
      IF (lbound==6) kadde = -1

      IF (lbound==1) THEN
        IF (found(1)<0) goto 666
        found(1)=1
      ELSEIF (lbound==2) THEN
        IF (found(2)<0) goto 666
        found(2)=1
      ELSEIF (lbound==3) THEN
        IF (found(3)<0) goto 666
        found(3)=1
      ELSEIF (lbound==4) THEN
        IF (found(4)<0) goto 666
        found(4)=1
      ELSEIF (lbound==5) THEN
        IF (found(5)<0) goto 666
        found(5)=1
      ELSEIF (lbound==6) THEN
        IF (found(6)<0) goto 666
        found(6)=1
      ENDIF

    ELSE  ! bcType

      IF (lbound==1) THEN
        IF (found(1)>0) goto 666
        found(1)=-1
      ELSEIF (lbound==2) THEN
        IF (found(2)>0) goto 666
        found(2)=-1
      ELSEIF (lbound==3) THEN
        IF (found(3)>0) goto 666
        found(3)=-1
      ELSEIF (lbound==4) THEN
        IF (found(4)>0) goto 666
        found(4)=-1
      ELSEIF (lbound==5) THEN
        IF (found(5)>0) goto 666
        found(5)=-1
      ELSEIF (lbound==6) THEN
        IF (found(6)>0) goto 666
        found(6)=-1
      ENDIF
    ENDIF   ! bcType
  ENDDO     ! iPatch

  goto 777

666 CONTINUE

  WRITE(stdout,*)'ERROR: Region', ireg, &
                 ' has mixed conn./phys. bc on same block side'
!  CALL ErrorStop( global,ERR_PATCH_DIMENS,__LINE__, &
!          'Only works if connecting BC covers whole, not partial, patch' )

777 CONTINUE

  IF (iflag == 0) THEN

! - increment global number of vertices and hexes for memory allocations

    DO k=kpnbeg+kaddb,kpnend+kadde
      DO j=jpnbeg+jaddb,jpnend+jadde
        DO i=ipnbeg+iaddb,ipnend+iadde
          global%tofluNVerts = global%tofluNVerts + 1  
        ENDDO
      ENDDO
    ENDDO

    DO k=kpnbeg,kpnend-1
      DO j=jpnbeg,jpnend-1
        DO i=ipnbeg,ipnend-1
          global%tofluNHexs = global%tofluNHexs + 1  
        ENDDO
      ENDDO
    ENDDO

! - similar for MAX number of vertices and faces (quads) at non-conn. patches
!   global%tofluNFaces rides along

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

      IF (bctype<bc_regionconf .OR. bctype>bc_regionconf+bc_range) THEN

        global%tofluNPatches = global%tofluNPatches + 1

        dims(1) = abs(patch%l1end-patch%l1beg) + 1    ! faces values
        dims(2) = abs(patch%l2end-patch%l2beg) + 1
        global%tofluNbfMax   = max( global%tofluNbfMax,dims(1)*dims(2) )
        global%tofluNFaces   = global%tofluNFaces + dims(1)*dims(2)

        dims(1) = abs(patch%l1end-patch%l1beg) + 2    ! nodes values
        dims(2) = abs(patch%l2end-patch%l2beg) + 2
        global%tofluNbnMax   = max( global%tofluNbnMax,dims(1)*dims(2) )
      ENDIF
    ENDDO

! - increment global number of faces and edges for dimension file

! - I-faces
    DO k=kpnbeg  ,kpnend-1
      DO j=jpnbeg  ,jpnend-1
        DO i=ipnbeg+1,ipnend-1
          global%tofluNFaces = global%tofluNFaces + 1  
        ENDDO
      ENDDO
    ENDDO

! - J-faces
    DO k=kpnbeg  ,kpnend-1
      DO j=jpnbeg+1,jpnend-1
        DO i=ipnbeg  ,ipnend-1
          global%tofluNFaces = global%tofluNFaces + 1  
        ENDDO
      ENDDO
    ENDDO

! - K-faces
    DO k=kpnbeg+1,kpnend-1
      DO j=jpnbeg  ,jpnend-1
        DO i=ipnbeg  ,ipnend-1
          global%tofluNFaces = global%tofluNFaces + 1  
        ENDDO
      ENDDO
    ENDDO

! - Edges
    DO k=kpnbeg,kpnend
      DO j=jpnbeg,jpnend
        DO i=ipnbeg,ipnend
          global%tofluNEdges = global%tofluNEdges + 3  
        ENDDO
      ENDDO
    ENDDO

! - Patch faces and edges
    DO ipatch=1,regions(ireg)%nPatches
      patch   => regions(ireg)%levels(ilev)%patches(ipatch)
      bctype  =  patch%bcType
      iregsrc =  patch%srcRegion

      IF ((bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) &
           .AND. iregsrc < ireg) THEN

        dims(1) = abs(patch%l1end-patch%l1beg) + 1    ! faces values
        dims(2) = abs(patch%l2end-patch%l2beg) + 1
        global%tofluNFaces = global%tofluNFaces + dims(1)*dims(2)

        dims(1) = abs(patch%l1end-patch%l1beg) + 2    ! nodes values
        dims(2) = abs(patch%l2end-patch%l2beg) + 2
        global%tofluNEdges = global%tofluNEdges - dims(1)*dims(2)*3
      ENDIF  ! bcType
    ENDDO

  ELSE   ! iFlag 

    ibn = indijk(idnbeg,jdnbeg,kdnbeg,inoff,ijnoff)
    ien = indijk(idnend,jdnend,kdnend,inoff,ijnoff)

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

    ALLOCATE( grid%xyz(3,ibn:ien),stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )

    ALLOCATE( grid%tofluLoc2g(ipnbeg:ipnend,jpnbeg:jpnend,kpnbeg:kpnend), &
              stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop( global,err_deallocate,__line__ )

! - read volume grid

    CALL rflo_readgridregion( ireg,regions )

! - obtain current region local-to-global (l2g) mapping -------------------------

    DO k=kpnbeg+kaddb,kpnend+kadde
      DO j=jpnbeg+jaddb,jpnend+jadde
        DO i=ipnbeg+iaddb,ipnend+iadde
          ijkn = indijk(i,j,k,inoff,ijnoff)

          global%tofluNVerts = global%tofluNVerts + 1  
          global%tofluXyz(1,global%tofluNVerts) = grid%xyz(xcoord,ijkn)  
          global%tofluXyz(2,global%tofluNVerts) = grid%xyz(ycoord,ijkn)  
          global%tofluXyz(3,global%tofluNVerts) = grid%xyz(zcoord,ijkn)
          grid%tofluLoc2g(i,j,k) = global%tofluNVerts
        ENDDO
      ENDDO
    ENDDO
  ENDIF  ! iFlag

  IF (iflag == 0) goto 888

! l2g mapping at connecting patches --------------------------------------------

  DO ipatch=1,regions(ireg)%nPatches

    patch     => regions(ireg)%levels(ilev)%patches(ipatch)
    lbound    =  patch%lbound
    bctype    =  patch%bcType
    iregsrc   =  patch%srcRegion

! - only at connecting patches and previous source regions

    IF ((bctype>=bc_regionconf .AND. bctype<=bc_regionconf + bc_range) .AND. &
        iregsrc < ireg) THEN

      align     = patch%align 
      ilevsrc   = regions(iregsrc)%currLevel
      lbs       = patch%srcLbound
      l1bs      = min(patch%srcL1beg,patch%srcL1end)
      l1es      = max(patch%srcL1beg,patch%srcL1end)
      l2bs      = min(patch%srcL2beg,patch%srcL2end)
      l2es      = max(patch%srcL2beg,patch%srcL2end)

! --- search for iPatchSrc

      DO ipatchsrc=1,regions(iregsrc)%nPatches
        patchsrc => regions(iregsrc)%levels(ilevsrc)%patches(ipatchsrc)

        IF (patchsrc%bcType==bctype .AND. &
            patchsrc%lbound==lbs    .AND. &
            patchsrc%l1beg ==l1bs   .AND. &
            patchsrc%l1end ==l1es   .AND. &
            patchsrc%l2beg ==l2bs   .AND. &
            patchsrc%l2end ==l2es) THEN       ! OK, iPatchSrc found
          patch%srcPatch = ipatchsrc
        ENDIF
      ENDDO    ! iPatchSrc

      ipatchsrc =  patch%srcPatch
      patchsrc  => regions(iregsrc)%levels(ilevsrc)%patches(ipatchsrc)
      gridsrc   => regions(iregsrc)%levels(ilevsrc)%grid

! --- copy l2g mapping from the source patch already processed to current patch

      CALL rflo_getpatchindicesnodes( regions(ireg),patch,ilev, &
                             ibeg,iend,jbeg,jend,kbeg,kend )
      CALL rflo_getpatchindicesnodes( regions(iregsrc),patchsrc,ilev, &
                             ibegsrc,iendsrc,jbegsrc,jendsrc,kbegsrc,kendsrc )
      CALL rflo_getpatchdirection( patch   ,idir   ,jdir,   kdir    )
      CALL rflo_getpatchdirection( patchsrc,idirsrc,jdirsrc,kdirsrc )

                                           l1srcdir =  1
      IF (patch%srcL1beg > patch%srcL1end) l1srcdir = -1
                                           l2srcdir =  1
      IF (patch%srcL2beg > patch%srcL2end) l2srcdir = -1

      CALL rflo_getpatchmapping( lbound,lbs,l1srcdir,l2srcdir,align, &
                                 idir,jdir,kdir,idirsrc,jdirsrc,kdirsrc, &
                                 ibeg,iend,jbeg,jend,kbeg,kend, &
                                 ibegsrc,iendsrc,jbegsrc,jendsrc, &
                                 kbegsrc,kendsrc,mapmat )

      IF (lbs==1) mapmat(1,4) = mapmat(1,4)+1
      IF (lbs==2) mapmat(1,4) = mapmat(1,4)-1
      IF (lbs==3) mapmat(2,4) = mapmat(2,4)+1
      IF (lbs==4) mapmat(2,4) = mapmat(2,4)-1
      IF (lbs==5) mapmat(3,4) = mapmat(3,4)+1
      IF (lbs==6) mapmat(3,4) = mapmat(3,4)-1
      DO k=kbeg,kend
        DO j=jbeg,jend
          DO i=ibeg,iend
            is = i*mapmat(1,1)+j*mapmat(1,2)+k*mapmat(1,3)+mapmat(1,4)
            js = i*mapmat(2,1)+j*mapmat(2,2)+k*mapmat(2,3)+mapmat(2,4)
            ks = i*mapmat(3,1)+j*mapmat(3,2)+k*mapmat(3,3)+mapmat(3,4)
            grid%tofluLoc2g(i,j,k) = gridsrc%tofluLoc2g(is,js,ks)
          ENDDO  ! i
        ENDDO    ! j
      ENDDO      ! k

    ENDIF ! bcType
  ENDDO ! iPatch

! obtain global hex connectivity ----------------------------------------------

  DO k=kpnbeg,kpnend-1
    DO j=jpnbeg,jpnend-1
      DO i=ipnbeg,ipnend-1
        global%tofluNHexs = global%tofluNHexs + 1  
        h = global%tofluNHexs
        global%tofluHex2v(1,h) = grid%tofluLoc2g(i  ,j  ,k  )
        global%tofluHex2v(2,h) = grid%tofluLoc2g(i  ,j  ,k+1)
        global%tofluHex2v(3,h) = grid%tofluLoc2g(i+1,j  ,k+1)
        global%tofluHex2v(4,h) = grid%tofluLoc2g(i+1,j  ,k  )
        global%tofluHex2v(5,h) = grid%tofluLoc2g(i  ,j+1,k  )
        global%tofluHex2v(6,h) = grid%tofluLoc2g(i  ,j+1,k+1)
        global%tofluHex2v(7,h) = grid%tofluLoc2g(i+1,j+1,k+1)
        global%tofluHex2v(8,h) = grid%tofluLoc2g(i+1,j+1,k  )
      ENDDO  ! i
    ENDDO  ! j
  ENDDO  ! k

888 CONTINUE

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

  CALL deregisterfunction( global )

END SUBROUTINE convertflo2flumesh

!******************************************************************************
!
! RCS Revision history:
!
! $Log: TFLU_ConvertFlo2FluMesh.F90,v $
! Revision 1.5  2008/12/06 08:44:53  mtcampbe
! Updated license.
!
! Revision 1.4  2008/11/19 22:18:03  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.3  2006/03/07 03:23:48  wasistho
! enabled serial execution
!
! Revision 1.2  2004/12/03 03:43:44  wasistho
! rflo_modinterfacestoflu to tflu_modinterfaces
!
! Revision 1.1  2004/12/03 02:59:30  wasistho
! added prefix
!
! Revision 1.1  2004/12/03 00:58:20  wasistho
! lower to upper case
!
! Revision 1.2  2004/08/18 02:10:33  wasistho
! added new routines to create dimension file
!
! Revision 1.1.1.1  2004/08/17 01:41:39  wasistho
! initial checkin
!
!
!******************************************************************************