RFLU_MinimumTimeStep.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: Calculate the minimum time step for all regions on all processors.
!
! Description: First determine smallest time step and region in which it 
!   occurs. If this smallest time step is smaller than that imposed by the 
!   user and smaller than the user-specified lower limit, then print out 
!   also in which cell the smallest time step occurs. This can be useful 
!   to analyze problems, particularly with moving grids. 
!
! Input: 
!   regions           Data of all regions
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
!
! $Id: RFLU_MinimumTimeStep.F90,v 1.14 2008/12/06 08:44:30 mtcampbe Exp $
!
! Copyright: (c) 2002-2005 by the University of Illinois
!
! ******************************************************************************

SUBROUTINE rflu_minimumtimestep(regions)

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

  IMPLICIT NONE

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

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

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

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

  CHARACTER(CHRLEN) :: rcsidentstring
  INTEGER :: errorflag,icelldtmin,ireg,iregdtmin
  INTEGER, DIMENSION(:), ALLOCATABLE :: globalvalsint,localvalsint  
  REAL(RFREAL) :: dtmin
  REAL(RFREAL), DIMENSION(:), ALLOCATABLE :: globalvalsreal,localvalsreal
  TYPE(t_global), POINTER :: global
  TYPE(t_region), POINTER :: pregion

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

  rcsidentstring = '$RCSfile: RFLU_MinimumTimeStep.F90,v $ $Revision: 1.14 $'

  global => regions(1)%global

  CALL registerfunction(global,'RFLU_MinimumTimeStep',&
  'RFLU_MinimumTimeStep.F90')

! ******************************************************************************
! Compute actual time step for each region. NOTE take into account CFL number 
! and user-specified minimum time step
! ******************************************************************************

  DO ireg = 1,global%nRegionsLocal
    pregion => regions(ireg)

    IF ( pregion%mixtInput%frozenFlag .EQV. .false. ) THEN 
      pregion%dtMin = pregion%mixtInput%cfl*pregion%dtMin       
      pregion%dtMin = min(global%dtImposed,pregion%dtMin)    
    ELSE 
      pregion%dtMin = global%dtImposed   
    END IF ! pRegion%mixtInput%frozenFlag
  END DO ! iReg

! ******************************************************************************
! Determine minimum time step over all processors
! ******************************************************************************

! ==============================================================================
! Allocate temporary memory
! ==============================================================================

  ALLOCATE(localvalsreal(0:global%nRegions),stat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'localValsReal')
  END IF ! global%error

  ALLOCATE(globalvalsreal(0:global%nRegions),stat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'globalValsReal')
  END IF ! global%error

! ==============================================================================
! Peform reduction operation. NOTE need to include region index 0 to make sure
! this works properly for serial runs.
! ==============================================================================

  DO ireg = 0,global%nRegions
    localvalsreal(ireg) = huge(1.0_rfreal)
  END DO ! iReg

  DO ireg = 1,global%nRegionsLocal
    pregion => regions(ireg)

    localvalsreal(pregion%iRegionGlobal) = pregion%dtMin
  END DO ! iReg    

  CALL mpi_allreduce(localvalsreal(0:global%nRegions), &
                     globalvalsreal(0:global%nRegions),global%nRegions+1, &
                     mpi_rfreal,mpi_min,global%mpiComm,errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_mpi_trouble,__line__)
  END IF ! global%errorFlag
  
! ==============================================================================
! Find smallest time step and store as global time step
! ==============================================================================

  dtmin = huge(1.0_rfreal) 

  DO ireg = 0,global%nRegions
    IF ( globalvalsreal(ireg) < dtmin ) THEN
      dtmin = globalvalsreal(ireg)
      iregdtmin = ireg
    END IF ! globalValsReal 
  END DO ! iReg

  DO ireg = 1,global%nRegionsLocal
    regions(ireg)%global%dtMin = dtmin
  END DO ! iReg

! ==============================================================================
! Deallocate temporary memory
! ==============================================================================

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

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

#ifndef GENX
! ******************************************************************************
! Store minimum time step as system time step for coupled simulations
! ******************************************************************************

  global%dTimeSystem = global%dtMin
#endif

! ******************************************************************************
! If smallest time step is smaller than user-specified time step and smaller 
! than user-specified limit, determine in which cell this occurs. NOTE the 
! region in which the smallest time step occurs has already been determined 
! above.
! ******************************************************************************

  IF ( global%dtMin < global%dtImposed .AND. & 
       global%dtMin < global%dtMinLimit ) THEN 

! ==============================================================================
!   Allocate temporary memory
! ==============================================================================

    ALLOCATE(localvalsint(0:global%nRegions),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'localValsInt')
    END IF ! global%error

    ALLOCATE(globalvalsint(0:global%nRegions),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'globalValsInt')
    END IF ! global%error
    
! ==============================================================================
!   Peform reduction operations. NOTE need to include region index 0 to make 
!   sure this works properly for serial runs.
! ==============================================================================
  
    DO ireg = 0,global%nRegions
      localvalsint(ireg) = -huge(1)
    END DO ! iReg  
    
    DO ireg = 1,global%nRegionsLocal
      pregion => regions(ireg)      

      localvalsint(pregion%iRegionGlobal) = pregion%dtMinLoc
    END DO ! iReg      

    CALL mpi_allreduce(localvalsint(0:global%nRegions), &
                       globalvalsint(0:global%nRegions),global%nRegions+1, &
                       mpi_integer,mpi_max,global%mpiComm,errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_mpi_trouble,__line__)
    END IF ! global%errorFlag

    IF ( global%myProcid == masterproc ) THEN 
      icelldtmin = globalvalsint(iregdtmin)
    END IF ! global%myProcid
    
! ==============================================================================
!   Deallocate temporary memory
! ==============================================================================

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

! ==============================================================================
!   Print information
! ==============================================================================

    IF ( global%myProcid == masterproc .AND. & 
         global%verbLevel > verbose_none ) THEN
      WRITE(stdout,'(A,1X,A)') solver_name,'Printing time step information...'
      WRITE(stdout,'(A,3X,A,1X,E16.9)') solver_name,'Smallest time step:', & 
                                        global%dtMin
      WRITE(stdout,'(A,3X,A)') solver_name,'Location of smallest time step:'
      WRITE(stdout,'(A,5X,A,4X,I6)') solver_name,'Region:',iregdtmin
      WRITE(stdout,'(A,5X,A,1X,I9)') solver_name,'Cell:  ',icelldtmin
      WRITE(stdout,'(A,1X,A)') solver_name, &
                               'Printing time step information done.'
    END IF ! global%myProcid
  END IF ! global%dtMin

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

  CALL deregisterfunction(global)

END SUBROUTINE rflu_minimumtimestep

! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_MinimumTimeStep.F90,v $
! Revision 1.14  2008/12/06 08:44:30  mtcampbe
! Updated license.
!
! Revision 1.13  2008/11/19 22:17:42  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.12  2005/11/10 22:24:04  fnajjar
! ACH: Added IF on frozenFlag
!
! Revision 1.11  2005/04/15 15:07:19  haselbac
! Converted to MPI
!
! Revision 1.10  2004/10/19 19:29:20  haselbac
! Bug fix so serial Charm jobs work properly, cosmetics
!
! Revision 1.9  2004/03/15 21:04:32  haselbac
! Fixed bug for serial runs: Had incorrect region pointer
!
! Revision 1.8  2003/10/19 01:45:53  haselbac
! Changed verbosity level
!
! Revision 1.7  2003/10/15 02:43:14  haselbac
! Rewrite; print information about location of time step if below limit
!
! Revision 1.6  2003/06/19 22:44:43  haselbac
! Set global%dTimeSystem so can use it in Tbc in rungeKutta outside GENX
!
! Revision 1.5  2003/03/15 18:39:12  haselbac
! Deleted superfluous statement
!
! Revision 1.4  2002/09/09 15:51:56  haselbac
! global and mixtInput now under region
!
! Revision 1.3  2002/07/25 14:28:49  haselbac
! Added FEM call to find minimum timestep for parallel runs
!
! Revision 1.2  2002/06/14 20:19:47  haselbac
! Deleted ModLocal, changed local%nRegions to global%nRegionsLocal
!
! Revision 1.1  2002/05/28 14:02:39  haselbac
! Initial revision
!
! ******************************************************************************