PLAG_WriteStatTecAscii.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: write Tecplot file for Lagragian statistics particle field 
!          onto Eulerian-based grid.
!
! Description: none.
!
! Input: regions  = pointer to all regions
!        iReg     = region number
!
! Output: to file.
!
! Notes: 
!   1.   The output is collected in one file, but the regions are processed
!        separately to save memory.
!
! ******************************************************************************
!
! $Id: PLAG_WriteStatTecAscii.F90,v 1.3 2008/12/06 08:45:07 mtcampbe Exp $
!
! Copyright: (c) 2005 by the University of Illinois
!
! ******************************************************************************

SUBROUTINE plag_writestattecascii( regions, iReg)

  USE moddatatypes
  USE moderror
  USE moddatastruct, ONLY : t_region
  USE modglobal,     ONLY : t_global
  USE modgrid,       ONLY : t_grid
  USE modpartlag,    ONLY : t_plag
  USE plag_modinterfacespost, ONLY : rflo_copygeometrydummy,   &
                                     rflo_generatecoarsegrids, &
                                     rflo_getcelloffset,       &
                                     rflo_getdimensphysnodes,  &
                                     rflo_getdimensdummy,      &
                                     rflo_getdimensdummynodes, &
                                     rflo_getnodeoffset,       &
                                     rflo_getcelloffset,       &
                                     rflo_getdimensphys,       &
                                     rflo_readgridregion, aver

  USE modparameters
  USE plag_modparameters
  
  IMPLICIT NONE

#include "Indexing.h"

! ******************************************************************************
! Declarations
! ******************************************************************************

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

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

  INTEGER, INTENT(IN) :: ireg

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

  CHARACTER(CHRLEN)   :: rcsidentstring
  CHARACTER(CHRLEN+4) :: fnametec
  CHARACTER(256)      :: varstrtec
  CHARACTER(16)       :: compstr
  
  INTEGER, PARAMETER :: if_plot_plagstat_tec = if_plot +210

  INTEGER :: ilev, ipc, jpc, kpc, ibc, iec, ibn, ien
  INTEGER :: idcbeg, idcend, jdcbeg, jdcend, kdcbeg, kdcend
  INTEGER :: ipcbeg, ipcend, jpcbeg, jpcend, kpcbeg, kpcend
  INTEGER :: idnbeg, idnend, jdnbeg, jdnend, kdnbeg, kdnend
  INTEGER :: ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend
  INTEGER :: icoff, ijcoff, inoff, ijnoff
  INTEGER :: errorflag
  INTEGER :: i,j,k, ijkn
  INTEGER :: cell(8),node(8)
  INTEGER :: ic,icont,itavcont
  INTEGER :: ijkcell,ijkdum
  INTEGER :: ncont,nev,ntav
  INTEGER, POINTER,      DIMENSION(:)   :: cvmass

  REAL(RFREAL) :: currenttime,rtimestat
  REAL(RFREAL) :: snumdens,sdiaml,sdiaml3,sdiaml4,smass
  REAL(RFREAL) :: xcell,ycell,zcell
  REAL(RFREAL) :: su,sv,sw,suu,svv,sww
  REAL(RFREAL), DIMENSION(:),   ALLOCATABLE :: scomp
  REAL(RFREAL), DIMENSION(:,:), POINTER :: tav
  
  TYPE(t_global), POINTER :: global
  TYPE(t_grid)  , POINTER :: grid
  TYPE(t_plag)  , POINTER :: pplag
  
!*******************************************************************************

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

  rcsidentstring = '$RCSfile: PLAG_WriteStatTecAscii.F90,v $ $Revision: 1.3 $'

  global => regions(ireg)%global

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

  IF (.NOT. global%plagUsed) goto 999

! ******************************************************************************
! Obtain region grid size
! ******************************************************************************

  DO ilev=2,regions(ireg)%nGridLevels
    ipc = regions(ireg)%levels(ilev-1)%grid%ipc
    jpc = regions(ireg)%levels(ilev-1)%grid%jpc
    kpc = regions(ireg)%levels(ilev-1)%grid%kpc
    regions(ireg)%levels(ilev)%grid%ipc = ipc/2
    regions(ireg)%levels(ilev)%grid%jpc = jpc/2
    regions(ireg)%levels(ilev)%grid%kpc = kpc/2
  ENDDO ! iLev

! ******************************************************************************
! Allocate memory for the grid (all grid levels)
! ******************************************************************************

  DO ilev=1,regions(ireg)%nGridLevels  
    CALL rflo_getdimensdummynodes( regions(ireg),ilev,idnbeg,idnend, &
                                   jdnbeg,jdnend,kdnbeg,kdnend )
    CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
    ibn  =  indijk(idnbeg,jdnbeg,kdnbeg,inoff,ijnoff)
    ien  =  indijk(idnend,jdnend,kdnend,inoff,ijnoff)

    grid => regions(ireg)%levels(ilev)%grid
    ALLOCATE( grid%xyz(3,ibn:ien),stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
  ENDDO ! iLev

! ******************************************************************************
! Set current grid level and get dummy cell dimensions
! ******************************************************************************

  ilev =  regions(ireg)%currLevel
  grid => regions(ireg)%levels(ilev)%grid

  CALL rflo_getdimensdummy( regions(ireg),ilev,idcbeg,idcend, &
                            jdcbeg,jdcend,kdcbeg,kdcend )
  CALL rflo_getcelloffset( regions(ireg),ilev,icoff,ijcoff )
  ibc = indijk(idcbeg,jdcbeg,kdcbeg,icoff,ijcoff)
  iec = indijk(idcend,jdcend,kdcend,icoff,ijcoff)

  CALL rflo_getdimensphysnodes( regions(ireg),ilev,ipnbeg,ipnend, &
                                jpnbeg,jpnend,kpnbeg,kpnend )
  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
  ibn = indijk(ipnbeg,jpnbeg,kpnbeg,inoff,ijnoff)
  ien = indijk(ipnend,jpnend,kpnend,inoff,ijnoff)

  CALL rflo_getdimensphys( regions(ireg),ilev,ipcbeg,ipcend, &
                           jpcbeg,jpcend,kpcbeg,kpcend )

! ******************************************************************************
! Save currentTime as global value is clobbered by RFLO_ReadGridRegion
! ******************************************************************************
  
  global%currentTime = global%timeStamp
  currenttime = global%currentTime 

! ******************************************************************************
! Read grid
! ******************************************************************************

  CALL rflo_readgridregion( ireg,regions )
  CALL rflo_generatecoarsegrids( regions(ireg) )
  CALL rflo_copygeometrydummy( regions(ireg) )

! ******************************************************************************
! Set pointers and variables
! ******************************************************************************
 
  pplag => regions(ireg)%levels(ilev)%plag

  tav  => pplag%tav

  cvmass => pplag%cvPlagMass
  
  ncont = regions(ireg)%plagInput%nCont
  ntav  = global%plagNStat
  itavcont = 7

  rtimestat = 1.0_rfreal/global%integrTime

! ******************************************************************************
! Allocate local memory
! ******************************************************************************
  
  ALLOCATE( scomp(ncont),stat=errorflag )
  global%error = errorflag
  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )   

! ******************************************************************************
! Write data to Tecplot file
! ******************************************************************************

! ==============================================================================
!  Open file and write the header
! ==============================================================================

   IF (ireg == 1) THEN
     WRITE(fnametec,'(A,ES11.5,A)') &
     trim(global%casename)//'.plag_stats_',currenttime,'.dat'
     OPEN(if_plot_plagstat_tec,file=fnametec,status='unknown',form='formatted',&
          iostat=errorflag)
     global%error = errorflag
     IF (global%error /= 0) &
       CALL errorstop( global,err_file_open,__line__,fnametec )     
     
     WRITE(if_plot_plagstat_tec,1005,err=10) &
       trim(global%casename),currenttime

     varstrtec = 'x y z <nDens> <diam> <u> <v> <w> <mass> '

     DO icont=1,ncont
       SELECT CASE (icont)
         CASE ( 0: 9)
          WRITE(compstr,'(A,I1,A)') '<comp_', icont,'>'
         CASE (10:99)
          WRITE(compstr,'(A,I2,A)') 'comp_', icont,'>'
         CASE default
          WRITE(compstr,'(A)') 'comp_?>'
       END SELECT ! iCont
       varstrtec = trim(varstrtec)//' '//trim(compstr)
     ENDDO ! iCont
     
     WRITE(compstr,'(A)') '<uu>'
     varstrtec = trim(varstrtec)//' '//trim(compstr)
     
     WRITE(if_plot_plagstat_tec,1010,err=10) trim(varstrtec)
   ENDIF   ! iReg=1

! ==============================================================================
!  Write zone header for plotting data based on nodes
! ==============================================================================

   WRITE(if_plot_plagstat_tec,1015) ireg,ipnend-ipnbeg+1,jpnend-jpnbeg+1,&
                                    kpnend-kpnbeg+1

! ==============================================================================
! Write plotting data
! ==============================================================================

  DO k=kpnbeg,kpnend
  DO j=jpnbeg,jpnend
  DO i=ipnbeg,ipnend
    ijkn = indijk(i,j,k,inoff,ijnoff)
    
    cell(1) = indijk(i  ,j  ,k  ,icoff,ijcoff)
    cell(2) = indijk(i-1,j  ,k  ,icoff,ijcoff)
    cell(3) = indijk(i  ,j-1,k  ,icoff,ijcoff)
    cell(4) = indijk(i-1,j-1,k  ,icoff,ijcoff)
    cell(5) = indijk(i  ,j  ,k-1,icoff,ijcoff)
    cell(6) = indijk(i-1,j  ,k-1,icoff,ijcoff)
    cell(7) = indijk(i  ,j-1,k-1,icoff,ijcoff)
    cell(8) = indijk(i-1,j-1,k-1,icoff,ijcoff)
    
    sdiaml3  = aver(cell,1,tav) *rtimestat ! 01 plagStatId
    sdiaml4  = aver(cell,2,tav) *rtimestat ! 02 
    snumdens = aver(cell,3,tav) *rtimestat ! 03  
    su       = aver(cell,4,tav) *rtimestat ! 04
    sv       = aver(cell,5,tav) *rtimestat ! 05
    sw       = aver(cell,6,tav) *rtimestat ! 06
    smass    = aver(cell,7,tav) *rtimestat ! 07

    DO icont = 1, ncont
      scomp(icont)   = aver(cell,itavcont+icont,tav) *rtimestat
      IF ( smass > 0.0_rfreal ) THEN
        scomp(icont) = scomp(icont)/smass
      ELSE
        scomp(icont) = 0.0_rfreal
      END IF ! smass
    END DO ! iCont
    
    suu = aver(cell,10,tav) *rtimestat    ! 44
    suu = suu -su*su

    IF( sdiaml3 > 0.0_rfreal) THEN
      sdiaml = sdiaml4/sdiaml3
    ELSE
      sdiaml = 0.0_rfreal
    ENDIF ! diamL3

    WRITE(if_plot_plagstat_tec,1020,err=10) grid%xyz(xcoord,ijkn),            &
                                            grid%xyz(ycoord,ijkn),            &
                                            grid%xyz(zcoord,ijkn),            &
                                            snumdens, sdiaml,                 &
                                            su,sv,sw,smass,                   &
                                           (scomp(icont),icont=1,ncont),      &
                                            suu

  ENDDO ! i
  ENDDO ! j
  ENDDO ! k

  print*,' PLAG_WriteStatTec: iReg, nDensSum = ',ireg,sum(tav(3,:))*rtimestat

! ******************************************************************************
! Deallocate memory
! ******************************************************************************

  DO ilev=1,regions(ireg)%nGridLevels
    grid => regions(ireg)%levels(ilev)%grid
    DEALLOCATE( grid%xyz,stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop( global,err_deallocate,__line__ )
  ENDDO ! iLev

! ******************************************************************************
! Allocate local memory
! ******************************************************************************
  
  DEALLOCATE( scomp,stat=errorflag )
  global%error = errorflag
  IF (global%error /= 0) CALL errorstop( global,err_deallocate,__line__ )   

! ******************************************************************************
! Finalize
! ******************************************************************************
 
  IF (ireg == global%nRegions) THEN
    CLOSE(if_plot_plagstat_tec,iostat=errorflag)
    global%error = errorflag
    IF (global%error /= 0) &
      CALL errorstop( global,err_file_close,__line__,fnametec )
  ENDIF

  goto 999

10   CONTINUE

999  CONTINUE
  CALL deregisterfunction( global )

! ******************************************************************************
! Formats
! ******************************************************************************

1005 FORMAT('TITLE="',a,'. Plag Statistics-Time: ',es11.5,'."')
1010 FORMAT('VARIABLES= ',a)
1015 FORMAT('ZONE T="',i5.5,'", I=',i6,', J=',i6,', K=',i6,', F=POINT')
1020 FORMAT(999(1x,es13.6))

END SUBROUTINE plag_writestattecascii

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_WriteStatTecAscii.F90,v $
! Revision 1.3  2008/12/06 08:45:07  mtcampbe
! Updated license.
!
! Revision 1.2  2008/11/19 22:18:18  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.1  2005/02/16 14:52:40  fnajjar
! Initial import
!
!******************************************************************************