RFLU_ModRegionMapping.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: Collection of routines relating to mapping of regions to processes. 
!
! Description: None.
!
! Input: None.
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
!
! $Id: RFLU_ModRegionMapping.F90,v 1.7 2008/12/06 08:44:23 mtcampbe Exp $
!
! Copyright: (c) 2004-2005 by the University of Illinois
!
! ******************************************************************************

MODULE rflu_modregionmapping

  USE modparameters
  USE moddatatypes
  USE moderror
  USE modglobal, ONLY: t_global
  USE moddatastruct, ONLY: t_level
  USE modmpi 

  USE modbuildfilenames, ONLY: buildfilenameplain
    
  IMPLICIT NONE
     
  PRIVATE
  PUBLIC :: rflu_applyregionmapping, &             
            rflu_buildregionmappingsimple, & 
            rflu_checkregionmapping, & 
            rflu_closeregionmappingfile, &
            rflu_createregionmapping, & 
            rflu_destroyregionmapping, &
            rflu_getproclocregids, & 
            rflu_imposeregionmappingserial, & 
            rflu_openregionmappingfile, &
            rflu_readregionmappingfile, & 
            rflu_setregionmappingserial, & 
            rflu_writeregionmappingfile

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
  CHARACTER(CHRLEN) :: RCSIdentString = & 
    '$RCSfile: RFLU_ModRegionMapping.F90,v $ $Revision: 1.7 $'
    
  INTEGER, PARAMETER, PUBLIC :: MAPTYPE_REG      = 1, & 
                                MAPTYPE_PROC2REG = 2        
             
! ******************************************************************************
! Routines
! ******************************************************************************

  CONTAINS









! ******************************************************************************
!
! Purpose: Apply region mapping.
!
! Description: None.
!
! Input: 
!   global      Pointer to global type
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_applyregionmapping(global,levels)

  IMPLICIT NONE
  
! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  

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

  TYPE(t_level), POINTER :: levels(:)
  TYPE(t_global), POINTER :: global

! ==============================================================================
! Local variables
! ==============================================================================

  INTEGER :: errorflag,ilev,ireg
  
! ******************************************************************************
! Start
! ******************************************************************************

  CALL registerfunction(global,'RFLU_ApplyRegionMapping',&
  'RFLU_ModRegionMapping.F90')

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN
    WRITE(stdout,'(A,1X,A)') solver_name,'Applying region mapping...'
  END IF ! global%verbLevel

! ******************************************************************************
! Copy global region number into region type
! ******************************************************************************
  
  ilev = 1
  
  DO ireg = 0,global%nRegionsLocal
    levels(ilev)%regions(ireg)%iRegionGlobal = global%regMap(ireg)
  END DO ! iReg  
  
  DO ilev = 2,global%nLevels    
    DO ireg = 1,global%nRegionsLocal
      levels(ilev)%regions(ireg)%iRegionGlobal = global%regMap(ireg)
    END DO ! iReg
  END DO ! iLev
    
! ******************************************************************************
! End
! ******************************************************************************
  
  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Applying region mapping done.'    
  END IF ! global%verbLevel
  
  CALL deregisterfunction(global)  
    
END SUBROUTINE rflu_applyregionmapping







! ******************************************************************************
!
! Purpose: Build simple region mapping.
!
! Description: None.
!
! Input:
!   global      Pointer to global data
!
! Output: None.
!
! Notes: 
!   1. This mapping simply maps an equal number of regions to each process 
!      without looking at the dimensions of each region.
!   2. If the number of regions is not divisible by the number of processes, 
!      the last process gets the remainder of regions. 
!
! ******************************************************************************

SUBROUTINE rflu_buildregionmappingsimple(global)

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
! ==============================================================================    
! Arguments
! ==============================================================================    
   
  TYPE(t_global), POINTER :: global 
   
! ==============================================================================    
! Locals
! ==============================================================================    
  
  INTEGER :: i,ibeg,iend,ioffset,iproc,nregsperproc

! ******************************************************************************
! Start
! ******************************************************************************  
    
  CALL registerfunction(global,'RFLU_BuildRegionMappingSimple',&
  'RFLU_ModRegionMapping.F90')

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_med) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Building region mapping...'
    WRITE(stdout,'(A,3X,A)') solver_name,'Method: Simple'
  END IF ! global%verbLevel  
    
! ******************************************************************************
! Build simple region mapping
! ******************************************************************************  

  nregsperproc = global%nRegions/global%nProcs ! NOTE integer division

  IF ( global%nRegions > 1 ) THEN 
    ioffset = 0
  ELSE 
    ioffset = 1
  END IF ! global%nRegions

  DO iproc = 1,global%nProcs  
    IF ( iproc > 1 ) THEN 
      ibeg = global%proc2RegMapInfo(2,iproc-1) + 1
    ELSE 
      ibeg = 1 
    END IF ! iProc 
    
    IF ( iproc /= global%nProcs ) THEN 
      iend = ibeg + nregsperproc - 1      
    ELSE ! Add remainder to last process
      iend = global%nRegions
    END IF ! iProc

    global%proc2RegMapInfo(1,iproc) = ibeg
    global%proc2RegMapInfo(2,iproc) = iend
  
    DO i = ibeg,iend
      global%proc2RegMap(i) = i - ioffset
    END DO ! i
  END DO ! iProc
    
! ******************************************************************************
! End
! ******************************************************************************  

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN    
    WRITE(stdout,'(A,1X,A)') solver_name,'Building region mapping done.'
  END IF ! global%verbLevel 

  CALL deregisterfunction(global)  

END SUBROUTINE rflu_buildregionmappingsimple








! ******************************************************************************
!
! Purpose: Check region mapping.
!
! Description: None.
!
! Input:
!   global      Pointer to global data
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_checkregionmapping(global)

  USE modsortsearch, ONLY: quicksortinteger 

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
! ==============================================================================    
! Arguments
! ==============================================================================    
   
  TYPE(t_global), POINTER :: global 
   
! ==============================================================================    
! Locals
! ==============================================================================    
  
  INTEGER :: checksum,errorflag,i
  INTEGER, DIMENSION(:), ALLOCATABLE :: proc2regmaptemp

! ******************************************************************************
! Start
! ******************************************************************************  
    
  CALL registerfunction(global,'RFLU_CheckRegionMapping',&
  'RFLU_ModRegionMapping.F90')

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Checking region mapping...'
  END IF ! global%verbLevel  
    
! ******************************************************************************
! Check region mapping
! ******************************************************************************  

  IF ( global%nRegions > 1 ) THEN 
    ALLOCATE(proc2regmaptemp(global%nRegions),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'proc2RegMapTemp')
    END IF ! global%error

    DO i = 1,global%nRegions
      proc2regmaptemp(i) = global%proc2RegMap(i)
    END DO ! i

    CALL quicksortinteger(proc2regmaptemp,global%nRegions)

    checksum = 0
    
    DO i = 1,global%nRegions
      checksum = checksum + proc2regmaptemp(i)
    END DO ! i
  
    IF ( checksum /= global%nRegions*(global%nRegions+1)/2 ) THEN 
      CALL errorstop(global,err_proc2reg_mapping,__line__)  
    END IF ! checkSum
    
    DEALLOCATE(proc2regmaptemp,stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_deallocate,__line__,'proc2RegMapTemp')
    END IF ! global%error    
  END IF ! global%nRegions
    
! ******************************************************************************
! End
! ******************************************************************************  

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN    
    WRITE(stdout,'(A,1X,A)') solver_name,'Checking region mapping done.'
  END IF ! global%verbLevel 

  CALL deregisterfunction(global)  

END SUBROUTINE rflu_checkregionmapping








! ******************************************************************************
!
! Purpose: Close region mapping file.
!
! Description: None.
!
! Input:
!   global      Pointer to global data
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_closeregionmappingfile(global)

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
! ==============================================================================    
! Arguments
! ==============================================================================    
   
  TYPE(t_global), POINTER :: global 
   
! ==============================================================================    
! Locals
! ==============================================================================    
  
  CHARACTER(CHRLEN) :: ifilename
  INTEGER :: errorflag

! ******************************************************************************
! Start
! ******************************************************************************  
    
  CALL registerfunction(global,'RFLU_CloseRegionMappingFile',&
  'RFLU_ModRegionMapping.F90')

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Closing region mapping file...'
  END IF ! global%verbLevel  
    
! ******************************************************************************
! Close file
! ******************************************************************************  

  CALL buildfilenameplain(global,filedest_indir,'.map',ifilename)  
    
  CLOSE(if_regmap,iostat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_file_close,__line__,ifilename) 
  END IF ! global%error    
    
! ******************************************************************************
! End
! ******************************************************************************  

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN    
    WRITE(stdout,'(A,1X,A)') solver_name,'Closing region mapping file done.'
  END IF ! global%verbLevel 

  CALL deregisterfunction(global)  

END SUBROUTINE rflu_closeregionmappingfile








! ******************************************************************************
!
! Purpose: Create region mapping.
!
! Description: None.
!
! Input:
!   global      Pointer to global data
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_createregionmapping(global,mapType)

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
! ==============================================================================    
! Arguments
! ==============================================================================    
   
  INTEGER, INTENT(IN) :: maptype 
  TYPE(t_global), POINTER :: global 
   
! ==============================================================================    
! Locals
! ==============================================================================    
  
  INTEGER :: errorflag

! ******************************************************************************
! Start
! ******************************************************************************  
    
  CALL registerfunction(global,'RFLU_CreateRegionMapping',&
  'RFLU_ModRegionMapping.F90')

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Creating region mapping...'
  END IF ! global%verbLevel  
    
! ******************************************************************************
! Create region mapping
! ******************************************************************************  

  IF ( maptype == maptype_reg ) THEN 
    ALLOCATE(global%regMap(0:global%nRegionsLocal),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'global%regMap')
    END IF ! global%error
  ELSE IF ( maptype == maptype_proc2reg ) THEN 
    ALLOCATE(global%proc2RegMap(global%nRegions),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'global%proc2RegMap')
    END IF ! global%error

    ALLOCATE(global%proc2RegMapInfo(2,global%nProcs),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'global%proc2RegMapInfo')
    END IF ! global%error    
  ELSE 
    CALL errorstop(global,err_reached_default,__line__)
  END IF ! mapType
    
! ******************************************************************************
! End
! ******************************************************************************  

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN    
    WRITE(stdout,'(A,1X,A)') solver_name,'Creating region mapping done.'
  END IF ! global%verbLevel 

  CALL deregisterfunction(global)  

END SUBROUTINE rflu_createregionmapping








! ******************************************************************************
!
! Purpose: Destroy region mapping.
!
! Description: None.
!
! Input:
!   global      Pointer to global data
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_destroyregionmapping(global,mapType)

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
! ==============================================================================    
! Arguments
! ==============================================================================    
   
  INTEGER, INTENT(IN) :: maptype 
  TYPE(t_global), POINTER :: global 
   
! ==============================================================================    
! Locals
! ==============================================================================    
  
  INTEGER :: errorflag

! ******************************************************************************
! Start
! ******************************************************************************  
    
  CALL registerfunction(global,'RFLU_DestroyRegionMapping',&
  'RFLU_ModRegionMapping.F90')

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Destroying region mapping...'
  END IF ! global%verbLevel  
    
! ******************************************************************************
! Create region mapping
! ******************************************************************************  

  IF ( maptype == maptype_reg ) THEN 
    DEALLOCATE(global%regMap,stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_deallocate,__line__,'global%regMap')
    END IF ! global%error
  ELSE IF ( maptype == maptype_proc2reg ) THEN 
    DEALLOCATE(global%proc2RegMap,stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_deallocate,__line__,'global%proc2RegMap')
    END IF ! global%error

    DEALLOCATE(global%proc2RegMapInfo,stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_deallocate,__line__,'global%proc2RegMapInfo')
    END IF ! global%error    
  ELSE 
    CALL errorstop(global,err_reached_default,__line__)
  END IF ! mapType
    
! ******************************************************************************
! End
! ******************************************************************************  

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN    
    WRITE(stdout,'(A,1X,A)') solver_name,'Destroying region mapping done.'
  END IF ! global%verbLevel 

  CALL deregisterfunction(global)  

END SUBROUTINE rflu_destroyregionmapping







! ******************************************************************************
!
! Purpose: Get process and local region ids given a set of global region ids.
!
! Description: None.
!
! Input: 
!   global              Pointer to global type
!   regIds              Set of region ids
!   nRegIds             Number of region ids
!
! Output: 
!   procIds             Set of process ids
!   locRegIds           Set of local region ids
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_getproclocregids(global,regIds,nRegIds,procIds,locRegIds)
  
  IMPLICIT NONE

! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

! ==============================================================================
! Parameters
! ==============================================================================

  INTEGER, INTENT(IN) :: nregids
  INTEGER, INTENT(IN) :: regids(nregids)
  INTEGER, INTENT(OUT) :: locregids(nregids),procids(nregids)
  TYPE(t_global), POINTER :: global

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

  CHARACTER(CHRLEN) :: sectionstring,targetstring
  INTEGER :: errorflag,ifile,iproc,ireg,iregid,iregid2,nprocs,nregionsglobal, & 
             nregionslocal

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

  CALL registerfunction(global,'RFLU_GetProcLocRegIds',&
  'RFLU_ModRegionMapping.F90')

! ******************************************************************************
! Set pointers and variables
! ******************************************************************************

  ifile = if_regmap

! ******************************************************************************
! Initialize output arrays
! ******************************************************************************

  DO iregid = 1,nregids
    procids(iregid)   = crazy_value_int
    locregids(iregid) = crazy_value_int
  END DO ! iRegIds

! ******************************************************************************
! Loop over region ids
! ******************************************************************************

  DO iregid = 1,nregids
    rewind(ifile)
  
! ==============================================================================
!   Read header
! ==============================================================================
  
    READ(ifile,'(A)') sectionstring
    IF ( trim(sectionstring) /= '# ROCFLU region mapping file' ) THEN 
      CALL errorstop(global,err_invalid_marker,__line__,trim(sectionstring)) 
    END IF ! TRIM

! ==============================================================================
!   Read number of regions and processors 
! ==============================================================================

    READ(ifile,'(A)') sectionstring
    IF ( trim(sectionstring) /= '# Number of regions' ) THEN 
      CALL errorstop(global,err_invalid_marker,__line__,trim(sectionstring)) 
    END IF ! TRIM

    READ(ifile,*) nregionsglobal

    IF ( nregionsglobal /= global%nRegions ) THEN 
      CALL errorstop(global,err_nregions_mismatch,__line__)
    END IF ! nRegionsGlobal

    READ(ifile,'(A)') sectionstring
    IF ( trim(sectionstring) /= '# Number of processes' ) THEN 
      CALL errorstop(global,err_invalid_marker,__line__,trim(sectionstring)) 
    END IF ! TRIM    

    READ(ifile,*) nprocs

    IF ( nprocs /= global%nProcs ) THEN 
      CALL errorstop(global,err_nprocs_mismatch,__line__)
    END IF ! nProcs
    
! ==============================================================================
!   Loop over processes and look for region id
! ==============================================================================

    procloop: DO iproc = 0,global%nProcs-1
      WRITE(targetstring,'(A,1X,I6.6)') '# Process',iproc+1       

      READ(ifile,'(A)') sectionstring        

      IF ( trim(sectionstring) /= trim(targetstring) ) THEN 
        CALL errorstop(global,err_invalid_marker,__line__,trim(sectionstring)) 
      END IF ! TRIM        

      READ(ifile,*) nregionslocal

      DO ireg = 1,nregionslocal
        READ(ifile,*) iregid2

        IF ( iregid2 == regids(iregid) ) THEN 
          procids(iregid)   = iproc+1
          locregids(iregid) = ireg
          
          EXIT procloop          
        END IF ! iRegId
      END DO ! iReg
    END DO procloop
  END DO ! iRegId   

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

  CALL deregisterfunction(global)

END SUBROUTINE rflu_getproclocregids








! ******************************************************************************
!
! Purpose: Impose serial region mapping.
!
! Description: None.
!
! Input: 
!   global              Pointer to global type
!
! Output: None.
!
! Notes: 
!   1. This routine must only be called if RFLU_ReadRegionMappingFile
!      was called with readMode equal to MAPFILE_READMODE_PEEK. There is no 
!      check for this here, so it is up to the user to make sure this is so.
!
! ******************************************************************************

SUBROUTINE rflu_imposeregionmappingserial(global)
  
  IMPLICIT NONE

! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

! ==============================================================================
! Parameters
! ==============================================================================

  TYPE(t_global), POINTER :: global

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

  INTEGER :: errorflag,ireg

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

  CALL registerfunction(global,'RFLU_ImposeRegionMappingSerial',&
  'RFLU_ModRegionMapping.F90')

  IF ( global%myProcid == masterproc .AND. & 
       global%verbLevel >= verbose_high ) THEN 
      WRITE(stdout,'(A,1X,A)') solver_name,'Imposing serial region mapping...' 
  END IF ! global%myProcid

! ******************************************************************************
! Set region mapping
! ******************************************************************************

  DO ireg = 0,global%nRegionsLocal
    global%regMap(ireg) = ireg        
  END DO ! iReg

  IF ( global%nRegionsLocal == 1 ) THEN ! for single-processor jobs
    global%regMap(1) = 0 
  END IF ! global%nRegionsLocal

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

  IF ( global%myProcid == masterproc .AND. & 
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Imposing serial region mapping done.'
  END IF ! global%verbLevel

  CALL deregisterfunction(global)

END SUBROUTINE rflu_imposeregionmappingserial








! ******************************************************************************
!
! Purpose: Open region mapping file.
!
! Description: None.
!
! Input:
!   global      Pointer to global data
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_openregionmappingfile(global)

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
! ==============================================================================    
! Arguments
! ==============================================================================    
   
  TYPE(t_global), POINTER :: global 
   
! ==============================================================================    
! Locals
! ==============================================================================    
  
  CHARACTER(CHRLEN) :: ifilename 
  INTEGER :: errorflag

! ******************************************************************************
! Start
! ******************************************************************************  
    
  CALL registerfunction(global,'RFLU_OpenRegionMappingFile',&
  'RFLU_ModRegionMapping.F90')

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Opening region mapping file...'
  END IF ! global%verbLevel  
    
! ******************************************************************************
! Open file
! ******************************************************************************  
    
  CALL buildfilenameplain(global,filedest_indir,'.map',ifilename)  

  OPEN(if_regmap,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    
    
! ******************************************************************************
! End
! ******************************************************************************  

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN    
    WRITE(stdout,'(A,1X,A)') solver_name,'Opening region mapping file done.'
  END IF ! global%verbLevel 

  CALL deregisterfunction(global)  

END SUBROUTINE rflu_openregionmappingfile









! ******************************************************************************
!
! Purpose: Read region mapping file for parallel processing
!
! Description: None.
!
! Input: 
!   global              Pointer to global type
!   readMode            Reading mode of file, can take only two values:
!                         MAPFILE_READMODE_ALL:  Read whole file
!                         MAPFILE_READMODE_PEEK: Read only number of regions
!   myProcId            Processor id
!
! Output: None.
!
! Notes: 
!   1. The complete file is only read if the readMode argument is set to 
!      MAPFILE_READMODE_ALL. If the readMode argument is set to 
!      MAPFILE_READMODE_PEEK, then only the number of regions is read, and 
!      the rest of the file is ignored. 
!
! ******************************************************************************

SUBROUTINE rflu_readregionmappingfile(global,readMode,myProcId)
  
  USE modbuildfilenames, ONLY: buildfilenameplain
  
  IMPLICIT NONE

! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

! ==============================================================================
! Parameters
! ==============================================================================

  INTEGER, INTENT(IN) :: myprocid,readmode 
  TYPE(t_global), POINTER :: global

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

  LOGICAL :: fileexists,foundentry
  CHARACTER(CHRLEN) :: dummystring,ifilename,sectionstring,targetstring
  INTEGER :: errorflag,ifile,iproc,ireg,nregions

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

  CALL registerfunction(global,'RFLU_ReadRegionMappingFile',&
  'RFLU_ModRegionMapping.F90')

  IF ( global%myProcid == masterproc ) THEN 
    IF ( global%verbLevel >= verbose_high ) THEN 
      WRITE(stdout,'(A,1X,A)') solver_name,'Reading region mapping file...'
      
      IF ( global%verbLevel >= verbose_med ) THEN 
        IF ( readmode == mapfile_readmode_all ) THEN 
          WRITE(stdout,'(A,3X,A)') solver_name,'Read mode: All'
        ELSE IF ( readmode == mapfile_readmode_peek ) THEN 
          WRITE(stdout,'(A,3X,A)') solver_name,'Read mode: Peek'    
        ELSE 
          CALL errorstop(global,err_reached_default,__line__)
        END IF ! readMode
      END IF ! global%verbLevel  
    END IF ! global%verbLevel
  END IF ! global%myProcid

! ******************************************************************************
! Test for existence of mapping file
! ******************************************************************************

  ifile = if_regmap
  
  CALL buildfilenameplain(global,filedest_indir,'.map',ifilename)

  INQUIRE(file=ifilename,exist=fileexists)

! ==============================================================================
! File exists
! ==============================================================================
  
  IF ( fileexists .EQV. .true. ) THEN     
    IF ( global%myProcid == masterproc .AND. &
         global%verbLevel >= verbose_high ) THEN
      WRITE(stdout,'(A,3X,A)') solver_name,'Mapping file found.' 
    END IF ! global%verbLevel  
  
! ------------------------------------------------------------------------------
!   Open file and read header
! ------------------------------------------------------------------------------  
  
    CALL rflu_openregionmappingfile(global)

    READ(ifile,'(A)') sectionstring
    IF ( trim(sectionstring) /= '# ROCFLU region mapping file' ) THEN 
      CALL errorstop(global,err_invalid_marker,__line__,trim(sectionstring)) 
    END IF ! TRIM

! ------------------------------------------------------------------------------
!   Read number of regions and processors 
! ------------------------------------------------------------------------------

    READ(ifile,'(A)') sectionstring
    IF ( trim(sectionstring) /= '# Number of regions' ) THEN 
      CALL errorstop(global,err_invalid_marker,__line__,trim(sectionstring)) 
    END IF ! TRIM

    READ(ifile,*) global%nRegions

    READ(ifile,'(A)') sectionstring
    IF ( trim(sectionstring) /= '# Number of processes' ) THEN 
      CALL errorstop(global,err_invalid_marker,__line__,trim(sectionstring)) 
    END IF ! TRIM    

    READ(ifile,*) global%nProcs

! ------------------------------------------------------------------------------
!   Read rest of file
! ------------------------------------------------------------------------------

    DO iproc = 0,global%nProcs-1
      foundentry = .false. 
    
      WRITE(targetstring,'(A,1X,I6.6)') '# Process',iproc+1       
      READ(ifile,'(A)') sectionstring 
             
      IF ( trim(sectionstring) /= trim(targetstring) ) THEN 
        CALL errorstop(global,err_invalid_marker,__line__,trim(sectionstring)) 
      END IF ! TRIM        

      READ(ifile,*) nregions

      IF ( iproc == myprocid ) THEN ! Found entry for my processor
        foundentry = .true.
      
        global%nRegionsLocal = nregions                        
      END IF ! iProc

      IF ( (foundentry .EQV. .true.) .AND. & 
           (readmode == mapfile_readmode_all) ) THEN
        global%regMap(0) = 0         

        DO ireg = 1,global%nRegionsLocal
          READ(ifile,*) global%regMap(ireg)
        END DO ! iReg
      ELSE       
        DO ireg = 1,nregions
          READ(ifile,'(A)') dummystring ! Read irrelevant lines
        END DO ! iReg                    
      END IF ! readMode  
    END DO ! iProc

    READ(ifile,'(A)') sectionstring        
    IF ( trim(sectionstring) /= '# End' ) THEN 
      CALL errorstop(global,err_invalid_marker,__line__,trim(sectionstring)) 
    END IF ! TRIM 

    CALL rflu_closeregionmappingfile(global)       
    
! ==============================================================================
! File does not exist, initialize for single-processor run
! ==============================================================================    
    
  ELSE IF ( (fileexists .EQV. .false.) .AND. (global%nProcAlloc == 1) ) THEN
    global%warnCounter = global%warnCounter + 1  
   
    IF ( global%myProcid == masterproc .AND. & 
         global%verbLevel >= verbose_none ) THEN 
      WRITE(stdout,'(A,3X,A,1X,A)') solver_name,'*** WARNING ***', & 
                                    'Mapping file not found.'
      WRITE(stdout,'(A,3X,A,1X,A)') solver_name,'Initializing for', & 
                                    'single-process run.'
    END IF ! global%verbLevel  
 
    global%nProcs        = 1
    global%nRegions      = 1
    global%nRegionsLocal = 1
    
! ==============================================================================
! File should exist but does not 
! ==============================================================================    
        
  ELSE 
    CALL errorstop(global,err_file_exist,__line__,trim(ifilename))
  END IF ! fileExists

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

  IF ( global%myProcid == masterproc .AND. & 
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Reading region mapping file done.'
  END IF ! global%verbLevel

  CALL deregisterfunction(global)

END SUBROUTINE rflu_readregionmappingfile









! ******************************************************************************
!
! Purpose: Set serial region mapping.
!
! Description: None.
!
! Input: 
!   global              Pointer to global type
!
! Output: None.
!
! Notes: 
!   1. This routine must only be called if RFLU_ReadRegionMappingFile
!      was called with readMode equal to MAPFILE_READMODE_PEEK. There is no 
!      check for this here, so it is up to the user to make sure this is so.
!
! ******************************************************************************

SUBROUTINE rflu_setregionmappingserial(global)
  
  IMPLICIT NONE

! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

! ==============================================================================
! Parameters
! ==============================================================================

  TYPE(t_global), POINTER :: global

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

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

  CALL registerfunction(global,'RFLU_SetRegionMappingSerial',&
  'RFLU_ModRegionMapping.F90')

  IF ( global%myProcid == masterproc .AND. & 
       global%verbLevel >= verbose_high ) THEN 
      WRITE(stdout,'(A,1X,A)') solver_name,'Setting serial region mapping...' 
  END IF ! global%myProcid

! ******************************************************************************
! Set serial region mapping
! ******************************************************************************

  global%nRegionsLocal = global%nRegions

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

  IF ( global%myProcid == masterproc .AND. & 
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Setting serial region mapping done.'
  END IF ! global%verbLevel

  CALL deregisterfunction(global)

END SUBROUTINE rflu_setregionmappingserial









! ******************************************************************************
!
! Purpose: Write region mapping file.
!
! Description: None.
!
! Input:
!   global      Pointer to global data
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_writeregionmappingfile(global)

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
! ==============================================================================    
! Arguments
! ==============================================================================    
   
  TYPE(t_global), POINTER :: global 
   
! ==============================================================================    
! Locals
! ==============================================================================    
  
  INTEGER :: i,ibeg,iend,iproc,nregions

! ******************************************************************************
! Start
! ******************************************************************************  
    
  CALL registerfunction(global,'RFLU_WriteRegionMappingFile',&
  'RFLU_ModRegionMapping.F90')

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Writing region mapping file...'
  END IF ! global%verbLevel  
    
! ******************************************************************************
! Write mapping file
! ******************************************************************************  
    
  WRITE(if_regmap,'(A)') '# ROCFLU region mapping file'
  
  WRITE(if_regmap,'(A)') '# Number of regions'
  WRITE(if_regmap,'(I7)') global%nRegions
    
  WRITE(if_regmap,'(A)') '# Number of processes'
  WRITE(if_regmap,'(I7)') global%nProcs
    
  DO iproc = 1,global%nProcs       
    WRITE(if_regmap,'(A,1X,I6.6)') '# Process',iproc

    ibeg = global%proc2RegMapInfo(1,iproc)
    iend = global%proc2RegMapInfo(2,iproc)

    WRITE(if_regmap,'(I7)') iend - ibeg + 1
    
    DO i = ibeg,iend
      WRITE(if_regmap,'(I7)') global%proc2RegMap(i)
    END DO ! i 
  END DO ! iProc  
    
  WRITE(if_regmap,'(A)') '# End'    
    
! ******************************************************************************
! End
! ******************************************************************************  

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN    
    WRITE(stdout,'(A,1X,A)') solver_name,'Writing region mapping file done.'
  END IF ! global%verbLevel 

  CALL deregisterfunction(global)  

END SUBROUTINE rflu_writeregionmappingfile







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

END MODULE rflu_modregionmapping

! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_ModRegionMapping.F90,v $
! Revision 1.7  2008/12/06 08:44:23  mtcampbe
! Updated license.
!
! Revision 1.6  2008/11/19 22:17:34  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.5  2007/03/31 23:53:13  haselbac
! Changed global region index for region 0 in parallel jobs
!
! Revision 1.4  2006/04/07 15:19:20  haselbac
! Removed tabs
!
! Revision 1.3  2005/04/15 15:07:01  haselbac
! Modified routine to get local proc ids
!
! Revision 1.2  2005/01/14 21:25:53  haselbac
! Added routine to get pid given regid, changed reading of map file
!
! Revision 1.1  2004/10/19 19:26:57  haselbac
! Initial revision
!
! ******************************************************************************