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

SUBROUTINE rvav_blasiussolution( 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

  INTEGER, PARAMETER        :: nfine=131073 
  INTEGER                   :: ijkn0,ijkn1,ijknr0, jtilde
  
  REAL(RFREAL), PARAMETER   :: simcoef=1.905_rfreal
  REAL(RFREAL)              :: yfin(nfine),varfin(2,nfine),varval(2),dumvar
  REAL(RFREAL)              :: reflen,refnu,refuvel,axialdist,deltastar,simcoord

  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_BlasiusSolution',&
  'RVAV_BlasiusSolution.F90' )
    
! generates Input DataStream for Blasius

  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( cvsa(2,ibc:iec) ,stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop( global, err_allocate,__line__ )

! - initialize variables 
           
    cvsa   = 0.0_rfreal  
    yfin   = 0.0_rfreal
    varfin = 0.0_rfreal
    nvari  = 2 
                
! - open file containing analytical Blasius solution
          
    WRITE(fname,'(A,A)') trim(globalrvav%casename)//'_finegrid.anl'
    OPEN(if_rvav_file_bl,file=fname,form='formatted',status='unknown') 

! - read in reference quantities and similarity data; rho, u stored in varFin(1:2,:)

    READ(if_rvav_file_bl,*,err=10,end=10) reflen
    READ(if_rvav_file_bl,*,err=10,end=10) refnu
    READ(if_rvav_file_bl,*,err=10,end=10) refuvel

    DO j = 1, nfine
      READ(if_rvav_file_bl,*,err=10,end=10) yfin(j),varfin(1,j),varfin(2,j),dumvar 
    ENDDO ! j

! - normalize solution component rho and u-velocity by their freestream values

    DO j = 1, nfine
      varfin(:,j) = varfin(:,j)/varfin(:,nfine) 
    ENDDO ! j

! - close file

    CLOSE(if_rvav_file_bl)

!-  interpolate analytical solution to cell centroid

    ijknr0 = indijk(ipcbeg,jpcbeg,kpcbeg,icoff,ijcoff)
    
    DO i = ipcbeg, ipcend
      ijkn0     = indijk(i     ,jpcbeg,kpcbeg,icoff,ijcoff)
      axialdist = cofg(xcoord,ijkn0)-cofg(xcoord,ijknr0)
      deltastar = max(simcoef*sqrt(refnu*axialdist/refuvel),1.0e-08_rfreal)

      jtilde=1 

      DO j = jpcbeg, jpcend 
        ijkn1    = indijk(i  ,j   ,kpcbeg,icoff,ijcoff)
        simcoord = cofg(ycoord,ijkn1)/deltastar

! - find the smallest jtilde such that simCoord is strictly lower than yFin(jtilde)

        DO WHILE ((simcoord >= yfin(jtilde)) .AND. (jtilde < nfine))
          jtilde=jtilde+1
        END DO

! - interpolate between values stored in 'Fin' arrays varFin

        CALL linintpol(nfine, jtilde, nvari, simcoord, yfin, varfin, varval)  

! - store the interpolated variables into cvSA
 
         cvsa(1:nvari,ijkn1)=varval(1:nvari)
       
        END DO ! j
          
    END DO ! i 

! - copy the solution to other k-layers

    DO k = kpcbeg+1, kpcend
    DO j = jpcbeg, jpcend 
    DO i = ipcbeg, ipcend 
      ijkn0    = indijk(i  ,j  ,k     ,icoff,ijcoff)
      ijknr0   = indijk(i  ,j  ,kpcbeg,icoff,ijcoff)
      cvsa(1:nvari,ijkn0) = cvsa(1:nvari,ijknr0)
    ENDDO ! i
    ENDDO ! j
    ENDDO ! 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 )
  
!----------------------------------------------------------------

CONTAINS 

  SUBROUTINE linintpol( nFine, jTilde, nComp, crsCoord, &
                        fincoord, varfin, varval)
  
! ... input variables
  INTEGER      :: nfine, jtilde, ncomp  
  REAL(RFREAL) :: crscoord
  REAL(RFREAL) :: fincoord(nfine), varfin(ncomp,nfine)
  
! ... output variables
  REAL(RFREAL) :: varval(ncomp)
  
! ... local variables
  INTEGER      :: l
  REAL(RFREAL) :: ratio

! - perform simple linear interpolation between the fine mesh data

  ratio=(crscoord-fincoord(jtilde-1))/(fincoord(jtilde)-fincoord(jtilde-1))
  DO l=1, ncomp
    varval(l) = varfin(l,jtilde-1) + ratio*(varfin(l,jtilde)-varfin(l,jtilde-1))
  ENDDO

  END SUBROUTINE linintpol  

END SUBROUTINE rvav_blasiussolution

!******************************************************************************
!
! RCS Revision history:
!
! $Log: RVAV_BlasiusSolution.F90,v $
! Revision 1.3  2008/12/06 08:45:08  mtcampbe
! Updated license.
!
! Revision 1.2  2008/11/19 22:18:18  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.1  2004/12/01 22:43:18  fnajjar
! Initial revision after changing case
!
! Revision 1.5  2003/05/15 02:57:07  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:00  f-najjar
! Initial Import
!
!
!******************************************************************************