RVAV_GammBumpSolution.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: Generate Analytical DataStream for GAMM Bump.
!
! Description: 
!
! Input: number of variables, extents 
!
! Output: array for Analytical solution
!
! Notes: 
!
!******************************************************************************
!
! $Id: RVAV_GammBumpSolution.F90,v 1.3 2008/12/06 08:45:08 mtcampbe Exp $
!
! Copyright: (c) 2002 by the University of Illinois
!
!******************************************************************************

SUBROUTINE rvav_gammbumpsolution( fname,regionsS1 )

  USE moddatatypes
  USE moderror
  USE moddatastruct, ONLY : t_region
  USE modglobal, ONLY     : t_global
  USE modgrid, ONLY       : t_grid
  USE modmixture, ONLY    : t_mixt
  USE modmpi
  USE modparameters
  USE rvav_modglobal
  USE rvav_modparameters
  IMPLICIT NONE

#include "Indexing.h"
  
! ... parameter 
  CHARACTER(*) :: fname  
  TYPE (t_region), POINTER :: regionss1(:)
   
! ... loop variables
  INTEGER :: i, j, k 
    
! ... local variables
  CHARACTER(CHRLEN) :: msg
  
  REAL(RFREAL), PARAMETER :: pressuretot = 1.0e+05_rfreal
  
  TYPE(t_grid)   , POINTER :: grid
  TYPE(t_mixt)   , POINTER :: mixt
  TYPE(t_global) , POINTER :: global

  INTEGER :: ireg, ilev  
  INTEGER :: ipc, jpc, kpc, ibc, iec
  INTEGER :: idcbeg, idcend, jdcbeg, jdcend, kdcbeg, kdcend
  INTEGER :: icoff, ijcoff
  INTEGER :: icelloffset, ijcelloffset
  INTEGER :: ibpc,iepc
  INTEGER :: ipcbeg, ipcend, jpcbeg, jpcend, kpcbeg, kpcend
  INTEGER :: ivars, inodes, jnodes, knodes, nvari, nvars
  INTEGER :: ijkcell, errorflag

  REAL(RFREAL), POINTER :: cofg(:,:)
  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: cvsa 
  
!******************************************************************************

  global => regionss1(1)%global
  
  CALL registerfunction( global,'RVAV_GAMMBUMPSolution',&
  'RVAV_GammBumpSolution.F90' )
    
! generates Input DataStream for GAMM Bump

  DO ireg=1, global%nRegions

    ilev =  regionss1(ireg)%currLevel
    grid => regionss1(ireg)%levels(ilev)%grid
    mixt => regionss1(ireg)%levels(ilev)%mixt
    
    cofg => grid%cofg
    
! - get cell dimensions

    CALL rflo_getdimensdummy( regionss1(ireg),ilev,idcbeg,idcend, &
                              jdcbeg,jdcend,kdcbeg,kdcend )
    CALL rflo_getcelloffset( regionss1(ireg),ilev,icelloffset,ijcelloffset )
    ibc = indijk(idcbeg,jdcbeg,kdcbeg,icelloffset,ijcelloffset)
    iec = indijk(idcend,jdcend,kdcend,icelloffset,ijcelloffset)   
     
! - get physical dimensions
      
    CALL rflo_getdimensphys( regionss1(ireg),ilev,ipcbeg,ipcend, &
                             jpcbeg,jpcend,kpcbeg,kpcend )
    CALL rflo_getcelloffset( regionss1(ireg),ilev,icoff,ijcoff )

! - allocate work array
              
    ALLOCATE( cvsa(1,ibc:iec) ,stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop( global, err_allocate,__line__ )

! - initialize variables 
    
    cvsa  = 0.0_rfreal
    nvari = 1 
        
    DO k = kpcbeg, kpcend
    DO j = jpcbeg, jpcend
    DO i = ipcbeg, ipcend     
      ijkcell = indijk(i,j,k,icoff,ijcoff)
      cvsa(1,ijkcell) = pressuretot
    END DO ! i
    END DO ! j 
    END DO ! k      
    
! Write stream2 data

    inodes = ipcend-ipcbeg+1
    jnodes = jpcend-jpcbeg+1
    knodes = kpcend-kpcbeg+1
    nvars  = zcoord+nvari
          
    WRITE(if_rvav_file_s2,*,err=10) inodes,jnodes,knodes,nvars 


    WRITE(if_rvav_file_s2,*,err=10) &
    (((cofg(xcoord,indijk(i,j,k,icoff,ijcoff)),   i=ipcbeg,ipcend), &
                                                  j=jpcbeg,jpcend), &
                                                  k=kpcbeg,kpcend), &
    (((cofg(ycoord,indijk(i,j,k,icoff,ijcoff)),   i=ipcbeg,ipcend), &
                                                  j=jpcbeg,jpcend), &
                                                  k=kpcbeg,kpcend), &
    (((cofg(zcoord,indijk(i,j,k,icoff,ijcoff)),   i=ipcbeg,ipcend), &
                                                  j=jpcbeg,jpcend), &
                                                  k=kpcbeg,kpcend), &
    ((((cvsa(ivars,indijk(i,j,k,icoff,ijcoff)),   i=ipcbeg,ipcend), &
                                                  j=jpcbeg,jpcend), &
                                                  k=kpcbeg,kpcend), &
                                                  ivars=1,nvari)
 
    DEALLOCATE( cvsa,stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop( global, err_deallocate,__line__ )   
      
  END DO ! iReg  

  goto 999
  
10  CONTINUE
    CALL errorstop( global, err_file_read,__line__,'File: '//trim(fname) ) 
    
! finalize --------------------------------------------------------------------

999 CONTINUE

  CALL deregisterfunction( global )

END SUBROUTINE rvav_gammbumpsolution

!******************************************************************************
!
! RCS Revision history:
!
! $Log: RVAV_GammBumpSolution.F90,v $
! Revision 1.3  2008/12/06 08:45:08  mtcampbe
! Updated license.
!
! Revision 1.2  2008/11/19 22:18:19  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.1  2004/12/01 22:43:23  fnajjar
! Initial revision after changing case
!
! Revision 1.5  2003/05/15 02:57:08  jblazek
! Inlined index function.
!
! Revision 1.4  2002/10/21 18:56:05  f-najjar
! Bug fix for Character Length of fname to be consistent with RVAV_ModInterfaces
!
! 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/10 00:01:45  f-najjar
! Variable global moved into regions()
!
! Revision 1.1  2002/07/31 02:36:24  f-najjar
! Initial Import
!
!
!******************************************************************************