SPLT_SplitGrid.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: split single grid into multiple regions.
!
! Description: none.
!
! Input: splitDirection = direction (i,j,k) in which the grid is to be splitted
!        regionsOld     = single grid and topology.
!
! Output: regionsNew = splitted grid.
!
! Notes: none.
!
!******************************************************************************
!
! $Id: SPLT_SplitGrid.F90,v 1.4 2008/12/06 08:44:51 mtcampbe Exp $
!
! Copyright: (c) 2001 by the University of Illinois
!
!******************************************************************************

SUBROUTINE splitgrid( splitDirection,regionsOld,regionsNew )

  USE moddatatypes
  USE moddatastruct, ONLY : t_region
  USE modglobal, ONLY     : t_global
  USE modgrid, ONLY       : t_grid
  USE splt_modinterfaces, ONLY : rflo_getdimensdummynodes, rflo_getnodeoffset
  USE moderror
  USE modparameters
  IMPLICIT NONE

#include "Indexing.h"

! ... parameters
  INTEGER :: splitdirection

  TYPE(t_region), POINTER :: regionsold(:), regionsnew(:)

! ... loop variables
  INTEGER :: ireg, i, j, k

! ... local variables
  INTEGER :: idnbeg, idnend, jdnbeg, jdnend, kdnbeg, kdnend, inoff, ijnoff
  INTEGER :: idnbegold, idnendold, jdnbegold, jdnendold, kdnbegold, kdnendold, &
             inoffold, ijnoffold, errorflag
  INTEGER :: ibn, ien, ijkn, ijknold, ii, jj, kk, ncells, npatches

  TYPE(t_global), POINTER :: globalnew
  TYPE(t_grid), POINTER   :: gridold, gridnew

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

  globalnew => regionsnew(1)%global

  CALL registerfunction( globalnew,'SplitGrid',&
  'SPLT_SplitGrid.F90' )

! allocate memory for new grid; set dimensions --------------------------------

  gridold  => regionsold(1)%levels(1)%grid
  npatches =  regionsold(1)%nPatches + 2     ! max. number of patches

  DO ireg=1,globalnew%nRegions

    ALLOCATE( regionsnew(ireg)%levels(1),stat=errorflag )
    ALLOCATE( regionsnew(ireg)%levels(1)%patches(npatches),stat=errorflag )
    globalnew%error = errorflag
    IF (globalnew%error /= 0) CALL errorstop( globalnew,err_allocate,__line__ )

    gridnew => regionsnew(ireg)%levels(1)%grid

    IF (splitdirection == 1) THEN
      gridnew%ipc = gridold%ipc/globalnew%nRegions
      gridnew%jpc = gridold%jpc
      gridnew%kpc = gridold%kpc
      IF (ireg == globalnew%nRegions) THEN
        gridnew%ipc = gridold%ipc - gridnew%ipc*(globalnew%nRegions-1)
      ENDIF
    ELSE IF (splitdirection == 2) THEN
      gridnew%ipc = gridold%ipc
      gridnew%jpc = gridold%jpc/globalnew%nRegions
      gridnew%kpc = gridold%kpc
      IF (ireg == globalnew%nRegions) THEN
        gridnew%jpc = gridold%jpc - gridnew%jpc*(globalnew%nRegions-1)
      ENDIF
    ELSE
      gridnew%ipc = gridold%ipc
      gridnew%jpc = gridold%jpc
      gridnew%kpc = gridold%kpc/globalnew%nRegions
      IF (ireg == globalnew%nRegions) THEN
        gridnew%kpc = gridold%kpc - gridnew%kpc*(globalnew%nRegions-1)
      ENDIF
    ENDIF
    regionsnew(ireg)%nGridLevels = regionsold(1)%nGridLevels
    regionsnew(ireg)%nDumCells   = 0
    regionsnew(ireg)%nPatches    = 0

    CALL rflo_getdimensdummynodes( regionsnew(ireg),1,idnbeg,idnend, &
                                   jdnbeg,jdnend,kdnbeg,kdnend )
    CALL rflo_getnodeoffset( regionsnew(ireg),1,inoff,ijnoff )
    ibn = indijk(idnbeg,jdnbeg,kdnbeg,inoff,ijnoff)
    ien = indijk(idnend,jdnend,kdnend,inoff,ijnoff)
    ALLOCATE( gridnew%xyz(3,ibn:ien),stat=errorflag )
    globalnew%error = errorflag
    IF (globalnew%error /= 0) CALL errorstop( globalnew,err_allocate,__line__ )

  ENDDO   ! iReg

! copy grid to new regions ----------------------------------------------------

  gridold => regionsold(1)%levels(1)%grid
  CALL rflo_getdimensdummynodes( regionsold(1),1,idnbegold,idnendold, &
                                 jdnbegold,jdnendold,kdnbegold,kdnendold )
  CALL rflo_getnodeoffset( regionsold(1),1,inoffold,ijnoffold )

  DO ireg=1,globalnew%nRegions

    gridnew => regionsnew(ireg)%levels(1)%grid
    CALL rflo_getdimensdummynodes( regionsnew(ireg),1,idnbeg,idnend, &
                                   jdnbeg,jdnend,kdnbeg,kdnend )
    CALL rflo_getnodeoffset( regionsnew(ireg),1,inoff,ijnoff )

    DO k=kdnbeg,kdnend
      DO j=jdnbeg,jdnend
        DO i=idnbeg,idnend
          ijkn = indijk(i,j,k,inoff,ijnoff)
          IF (splitdirection == 1) THEN
            ncells  = gridold%ipc/globalnew%nRegions
            ii      = i + (ireg-1)*ncells
            ijknold = indijk(ii,j,k,inoffold,ijnoffold)
          ELSE IF (splitdirection == 2) THEN
            ncells  = gridold%jpc/globalnew%nRegions
            jj      = j + (ireg-1)*ncells
            ijknold = indijk(i,jj,k,inoffold,ijnoffold)
          ELSE
            ncells  = gridold%kpc/globalnew%nRegions
            kk      = k + (ireg-1)*ncells
            ijknold = indijk(i,j,kk,inoffold,ijnoffold)
          ENDIF
          gridnew%xyz(xcoord,ijkn) = gridold%xyz(xcoord,ijknold)
          gridnew%xyz(ycoord,ijkn) = gridold%xyz(ycoord,ijknold)
          gridnew%xyz(zcoord,ijkn) = gridold%xyz(zcoord,ijknold)
        ENDDO
      ENDDO
    ENDDO

  ENDDO   ! iReg

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

  CALL deregisterfunction( globalnew )

END SUBROUTINE splitgrid

!******************************************************************************
!
! RCS Revision history:
!
! $Log: SPLT_SplitGrid.F90,v $
! Revision 1.4  2008/12/06 08:44:51  mtcampbe
! Updated license.
!
! Revision 1.3  2008/11/19 22:18:01  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.2  2004/12/03 03:33:31  wasistho
! rflo_modinterfacessplit to splt_modinterfaces
!
! Revision 1.1  2004/12/03 02:41:15  wasistho
! added prefix
!
! Revision 1.1  2004/12/03 00:45:30  wasistho
! lower to upper case
!
! Revision 1.6  2003/05/15 02:57:07  jblazek
! Inlined index function.
!
! Revision 1.5  2003/03/20 22:32:37  haselbac
! Renamed ModInterfaces
!
! Revision 1.4  2003/03/20 19:45:54  haselbac
! Corrected mistake in phased check-in
!
! Revision 1.3  2002/10/12 03:20:51  jblazek
! Replaced [io]stat=global%error with local errorFlag for Rocflo.
!
! Revision 1.2  2002/09/05 17:40:22  jblazek
! Variable global moved into regions().
!
! Revision 1.1  2002/07/12 21:50:08  jblazek
! Added tool to split single grid into multiple regions.
!
!******************************************************************************