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

SUBROUTINE rvav_proudmanculicksolution( 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 :: massfluxc0 = 2.42_rfreal
  REAL(RFREAL), PARAMETER :: tempwallc0 = 303.0_rfreal
  REAL(RFREAL), PARAMETER :: pressureheadend = 1.53451e+05_rfreal
  REAL(RFREAL), PARAMETER :: heightc0 = 0.02

  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) :: pi
  REAL(RFREAL), POINTER :: cofg(:,:)
  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: cvsa
  
!******************************************************************************

  global => regionss1(1)%global
  
  CALL registerfunction( global, 'RVAV_ProudmanCulickSolution',&
  'RVAV_ProudmanCulickSolution.F90' )
  
  pi =  global%pi

! generate Input DataStream for Proudman Culick

  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(3,ibc:iec),stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop( global, err_allocate,__line__ )
    
! - initialize variables 
           
    cvsa = 0.0_rfreal
    ipcbeg = 1
    ipcend = 1
    nvari  = 3 

    DO k = kpcbeg, kpcend
    DO j = jpcbeg, jpcend 
    DO i = ipcbeg, ipcend 
      ijkcell = indijk(i,j,k,icoff,ijcoff)
        
      cvsa(1,ijkcell) = sin(0.5_rfreal*pi*cofg(ycoord,ijkcell)/heightc0)
      cvsa(2,ijkcell) = cos(0.5_rfreal*pi*cofg(ycoord,ijkcell)/heightc0)
      cvsa(3,ijkcell) = pressureheadend
    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_proudmanculicksolution

!******************************************************************************
!
! RCS Revision history:
!
! $Log: RVAV_ProudmanCulickSolution.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:46:35  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:43  f-najjar
! Initial Import
!
!
!******************************************************************************