RFLU_ModGatherData.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: Gather and scatter solution data.
!
! Description: None
!
! Notes:
!   1. This module collects routines to gather and scatter solution data
!      when partitioning or merging solution data for parallel multi-physics
!      calculations. The way the partitioning and merging is done means that
!      a single solution vector must be used. Since the solution data for
!      multi-physics calculations in RocfluMP is stored separately, it needs
!      to be gathered before partitioning, and scattered after merging.
!
! ******************************************************************************
!
! $Id: RFLU_ModGatherData.F90,v 1.8 2008/12/06 08:44:22 mtcampbe Exp $
!
! Copyright: (c) 2003-2004 by the University of Illinois
!
! ******************************************************************************

MODULE rflu_modgatherdata

  USE moddatatypes
  USE modparameters
  USE modglobal, ONLY: t_global
  USE moddatastruct, ONLY: t_region
  USE modgrid, ONLY: t_grid
  USE moderror

  IMPLICIT NONE

  PRIVATE
  PUBLIC :: rflu_countgathereddata, &
            rflu_creategathereddata, &
            rflu_destroygathereddata, &             
            rflu_gatherdata, &
            rflu_scattergathereddata

  INTEGER, PARAMETER, PUBLIC :: GATHER_MODE_ACTUAL_ONLY    = 1, &
                                GATHER_MODE_ACTUAL_VIRTUAL = 2

  CONTAINS


! ******************************************************************************
!
! Purpose: Count gathered data - determine number of variables
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!
! Output: 
!   nVarsOut    Number of variables to be gathered
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_countgathereddata(pRegion,nVarsOut)

! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************

! ==============================================================================
!   Arguments
! ==============================================================================

    INTEGER, INTENT(OUT) :: nvarsout
    TYPE(t_region), POINTER :: pregion

! ==============================================================================
!   Locals
! ==============================================================================

    INTEGER :: nvars
    TYPE(t_global), POINTER :: global

! ******************************************************************************
!   Start
! ******************************************************************************

    global => pregion%global

    CALL registerfunction(global,'RFLU_CountGatheredData',&
  'RFLU_ModGatherData.F90')

! ******************************************************************************
!   Determine number of variables
! ******************************************************************************

! ==============================================================================
!   Mixture
! ==============================================================================

    nvars = pregion%mixtInput%nCv

! ==============================================================================
!   Physical modules
! ==============================================================================

#ifdef SPEC
    IF ( global%specUsed .EQV. .true. ) THEN
      nvars = nvars + pregion%specInput%nSpecies
    END IF ! global%specUsed
#endif

! ******************************************************************************
!   Set nVarsOut
! ******************************************************************************

    nvarsout = nvars

! ******************************************************************************
!   End
! ******************************************************************************

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_countgathereddata





! ******************************************************************************
!
! Purpose: Create gathered data
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!   icType      Cell type
!   gatherMode  Gather mode
!
! Output: 
!   nVarsOut    Number of variables to be gathered
!   cv          Array to hold gathered data
!
! Notes:
!   1. Gather mode indicates whether actual cells or virtual cells are to 
!      be gathered.
!
! ******************************************************************************

  SUBROUTINE rflu_creategathereddata(pRegion,icType,gatherMode,nVarsOut,cv)

! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************

! ==============================================================================
!   Arguments
! ==============================================================================

    INTEGER, INTENT(IN) :: gathermode,ictype
    INTEGER, INTENT(OUT) :: nvarsout
    REAL(RFREAL), DIMENSION(:,:), POINTER :: cv
    TYPE(t_region), POINTER :: pregion

! ==============================================================================
!   Locals
! ==============================================================================

    INTEGER :: errorflag,ncells,nvars
    TYPE(t_global), POINTER :: global
    TYPE(t_grid), POINTER :: pgrid

! ******************************************************************************
!   Start
! ******************************************************************************

    global => pregion%global

    CALL registerfunction(global,'RFLU_CreateGatheredData',&
  'RFLU_ModGatherData.F90')

! ******************************************************************************
!   Set pointers
! ******************************************************************************

    pgrid => pregion%grid

! ******************************************************************************
!   Determine number of variables
! ******************************************************************************

    CALL rflu_countgathereddata(pregion,nvars)

! ******************************************************************************
!   Determine number of cells
! ******************************************************************************

    SELECT CASE ( gathermode )
      CASE ( gather_mode_actual_only )
        SELECT CASE ( ictype )
          CASE ( cell_type_tet )
            ncells = pgrid%nTets
          CASE ( cell_type_hex )
            ncells = pgrid%nHexs
          CASE ( cell_type_pri )
            ncells = pgrid%nPris
          CASE ( cell_type_pyr )
            ncells = pgrid%nPyrs
          CASE default
            CALL errorstop(global,err_reached_default,__line__)
        END SELECT ! icType
      CASE ( gather_mode_actual_virtual )
        SELECT CASE ( ictype )
          CASE ( cell_type_tet )
            ncells = pgrid%nTetsTot
          CASE ( cell_type_hex )
            ncells = pgrid%nHexsTot
          CASE ( cell_type_pri )
            ncells = pgrid%nPrisTot
          CASE ( cell_type_pyr )
            ncells = pgrid%nPyrsTot
          CASE default
            CALL errorstop(global,err_reached_default,__line__)
        END SELECT ! icType
      CASE default
        CALL errorstop(global,err_reached_default,__line__)
    END SELECT ! gatherMode

! ******************************************************************************
!   Set nVarsOut
! ******************************************************************************

    nvarsout = nvars

! ******************************************************************************
!   Allocate memory
! ******************************************************************************

    ALLOCATE(cv(nvars,ncells),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN
      CALL errorstop(global,err_allocate,__line__,'cv')
    END IF ! global%error

! ******************************************************************************
!   End
! ******************************************************************************

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_creategathereddata







! ******************************************************************************
!
! Purpose: Destroy gathered data
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!
! Output: 
!   cv          Array to be destroyed
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_destroygathereddata(pRegion,cv)

! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************

! ==============================================================================
!   Arguments
! ==============================================================================

    REAL(RFREAL), DIMENSION(:,:), POINTER :: cv
    TYPE(t_region), POINTER :: pregion

! ==============================================================================
!   Locals
! ==============================================================================

    INTEGER :: errorflag
    TYPE(t_global), POINTER :: global

! ******************************************************************************
!   Start
! ******************************************************************************

    global => pregion%global

    CALL registerfunction(global,'RFLU_DestroyGatheredData',&
  'RFLU_ModGatherData.F90')

! ******************************************************************************
!   Deallocate memory
! ******************************************************************************

    DEALLOCATE(cv,stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN
      CALL errorstop(global,err_deallocate,__line__,'cv')
    END IF ! global%error

! ******************************************************************************
!   End
! ******************************************************************************

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_destroygathereddata






! ******************************************************************************
!
! Purpose: Gather data
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!   icType      Cell type
!   gatherMode  Gather mode
!
! Output: 
!   cv          Gathered data
!
! Notes:
!   1. Gather mode indicates whether actual cells or virtual cells are to 
!      be gathered.
!
! ******************************************************************************

  SUBROUTINE rflu_gatherdata(pRegion,icType,gatherMode,cv)

! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************

! ==============================================================================
!   Arguments
! ==============================================================================

    INTEGER, INTENT(IN) :: gathermode,ictype
    REAL(RFREAL), DIMENSION(:,:), POINTER :: cv
    TYPE(t_region), POINTER :: pregion

! ==============================================================================
!   Locals
! ==============================================================================

    INTEGER :: errorflag,icg,icl,ivar,ncells,nvars
    INTEGER, DIMENSION(:), POINTER :: pxyz2cellglob
    REAL(RFREAL), DIMENSION(:,:), POINTER :: pvar
    TYPE(t_global), POINTER :: global
    TYPE(t_grid), POINTER :: pgrid

! ******************************************************************************
!   Start
! ******************************************************************************

    global => pregion%global

    CALL registerfunction(global,'RFLU_GatherData',&
  'RFLU_ModGatherData.F90')

! ******************************************************************************
!   Set pointers
! ******************************************************************************

    pgrid => pregion%grid

! ******************************************************************************
!   Determine number of cells and set renumbering pointer
! ******************************************************************************

    SELECT CASE ( gathermode )
      CASE ( gather_mode_actual_only )
        SELECT CASE ( ictype )
          CASE ( cell_type_tet )
            ncells = pgrid%nTets
            pxyz2cellglob => pgrid%tet2CellGlob
          CASE ( cell_type_hex )
            ncells = pgrid%nHexs
            pxyz2cellglob => pgrid%hex2CellGlob
          CASE ( cell_type_pri )
            ncells = pgrid%nPris
            pxyz2cellglob => pgrid%pri2CellGlob
          CASE ( cell_type_pyr )
            ncells = pgrid%nPyrs
            pxyz2cellglob => pgrid%pyr2CellGlob
          CASE default
            CALL errorstop(global,err_reached_default,__line__)
        END SELECT ! icType
      CASE ( gather_mode_actual_virtual )
        SELECT CASE ( ictype )
          CASE ( cell_type_tet )
            ncells = pgrid%nTetsTot
            pxyz2cellglob => pgrid%tet2CellGlob
          CASE ( cell_type_hex )
            ncells = pgrid%nHexsTot
            pxyz2cellglob => pgrid%hex2CellGlob
          CASE ( cell_type_pri )
            ncells = pgrid%nPrisTot
            pxyz2cellglob => pgrid%pri2CellGlob
          CASE ( cell_type_pyr )
            ncells = pgrid%nPyrsTot
            pxyz2cellglob => pgrid%pyr2CellGlob
          CASE default
            CALL errorstop(global,err_reached_default,__line__)
        END SELECT ! icType
      CASE default
        CALL errorstop(global,err_reached_default,__line__)
    END SELECT ! gatherMode

! ******************************************************************************
!   Gather data
! ******************************************************************************

    DO icl = 1,ncells
      icg = pxyz2cellglob(icl)

      nvars = 0

! ==============================================================================
!     Mixture
! ==============================================================================

      pvar => pregion%mixt%cv

      DO ivar = cv_mixt_dens,cv_mixt_ener
        nvars = nvars + 1
        cv(nvars,icl) = pvar(ivar,icg)
      END DO ! iVar

! ==============================================================================
!     Physical modules
! ==============================================================================

#ifdef SPEC
      IF ( global%specUsed .EQV. .true. ) THEN
        pvar => pregion%spec%cv

        DO ivar = 1,pregion%specInput%nSpecies
          nvars = nvars + 1
          cv(nvars,icl) = pvar(ivar,icg)
        END DO ! iVar
      END IF ! global%specUsed
#endif
    END DO ! icl

! ******************************************************************************
!   End
! ******************************************************************************

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_gatherdata






! ******************************************************************************
!
! Purpose: Scatter gathered data
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!   icType      Cell type
!   gatherMode  Gather mode
!
! Output: 
!   cv          Array holding gathered data
!
! Notes:
!   1. Gather mode indicates whether actual cells or virtual cells are to 
!      be scattered.
!
! ******************************************************************************

  SUBROUTINE rflu_scattergathereddata(pRegion,icType,gatherMode,cv)

! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************

! ==============================================================================
!   Arguments
! ==============================================================================

    INTEGER, INTENT(IN) :: gathermode,ictype
    REAL(RFREAL), DIMENSION(:,:), POINTER :: cv
    TYPE(t_region), POINTER :: pregion

! ==============================================================================
!   Locals
! ==============================================================================

    INTEGER :: errorflag,icg,icl,ivar,ncells,nvars
    INTEGER, DIMENSION(:), POINTER :: pxyz2cellglob
    REAL(RFREAL), DIMENSION(:,:), POINTER :: pvar
    TYPE(t_global), POINTER :: global
    TYPE(t_grid), POINTER :: pgrid

! ******************************************************************************
!   Start
! ******************************************************************************

    global => pregion%global

    CALL registerfunction(global,'RFLU_ScatterGatheredData',&
  'RFLU_ModGatherData.F90')

! ******************************************************************************
!   Set pointers
! ******************************************************************************

    pgrid => pregion%grid

! ******************************************************************************
!   Determine number of cells and set renumbering pointer
! ******************************************************************************

    SELECT CASE ( gathermode )
      CASE ( gather_mode_actual_only )
        SELECT CASE ( ictype )
          CASE ( cell_type_tet )
            ncells = pgrid%nTets
            pxyz2cellglob => pgrid%tet2CellGlob
          CASE ( cell_type_hex )
            ncells = pgrid%nHexs
            pxyz2cellglob => pgrid%hex2CellGlob
          CASE ( cell_type_pri )
            ncells = pgrid%nPris
            pxyz2cellglob => pgrid%pri2CellGlob
          CASE ( cell_type_pyr )
            ncells = pgrid%nPyrs
            pxyz2cellglob => pgrid%pyr2CellGlob
          CASE default
            CALL errorstop(global,err_reached_default,__line__)
        END SELECT ! icType
      CASE ( gather_mode_actual_virtual )
        SELECT CASE ( ictype )
          CASE ( cell_type_tet )
            ncells = pgrid%nTetsTot
            pxyz2cellglob => pgrid%tet2CellGlob
          CASE ( cell_type_hex )
            ncells = pgrid%nHexsTot
            pxyz2cellglob => pgrid%hex2CellGlob
          CASE ( cell_type_pri )
            ncells = pgrid%nPrisTot
            pxyz2cellglob => pgrid%pri2CellGlob
          CASE ( cell_type_pyr )
            ncells = pgrid%nPyrsTot
            pxyz2cellglob => pgrid%pyr2CellGlob
          CASE default
            CALL errorstop(global,err_reached_default,__line__)
        END SELECT ! icType
      CASE default
        CALL errorstop(global,err_reached_default,__line__)
    END SELECT ! gatherMode

! ******************************************************************************
!   Scatter data for actual cells
! ******************************************************************************

    DO icl = 1,ncells
      icg = pxyz2cellglob(icl)

      nvars = 0

! ==============================================================================
!     Mixture
! ==============================================================================

      pvar => pregion%mixt%cv

      DO ivar = cv_mixt_dens,cv_mixt_ener
        nvars = nvars + 1
        pvar(ivar,icg) = cv(nvars,icl)
      END DO ! iVar

! ==============================================================================
!     Physical modules
! ==============================================================================

#ifdef SPEC
      IF ( global%specUsed .EQV. .true. ) THEN
        pvar => pregion%spec%cv

        DO ivar = 1,pregion%specInput%nSpecies
          nvars = nvars + 1
          pvar(ivar,icg) = cv(nvars,icl)
        END DO ! iVar
      END IF ! global%specUsed
#endif
    END DO ! icl

! ******************************************************************************
!   End
! ******************************************************************************

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_scattergathereddata




END MODULE rflu_modgatherdata

! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_ModGatherData.F90,v $
! Revision 1.8  2008/12/06 08:44:22  mtcampbe
! Updated license.
!
! Revision 1.7  2008/11/19 22:17:33  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.6  2006/04/07 15:19:19  haselbac
! Removed tabs
!
! Revision 1.5  2004/11/02 02:31:56  haselbac
! Replaced CV_MIXT_NEQS
!
! Revision 1.4  2004/10/19 19:27:56  haselbac
! Clean-up
!
! Revision 1.3  2004/07/28 15:29:20  jferry
! created global variable for spec use
!
! Revision 1.2  2004/01/22 16:03:59  haselbac
! Made contents of modules PRIVATE, only procs PUBLIC, to avoid errors on ALC 
! and titan
!
! Revision 1.1  2003/11/25 21:03:30  haselbac
! Initial revision
!
! ******************************************************************************