TURB_floLesGenFiltFFK.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: Perform face to face filtering in K-direction.
!
! Description: The filtering is performed using the filter coefficients stored
!              in turb%ffCofk1,2,4. If filterwidth is zero in this direction
!              the cell-variable is simply copied to the filtered cell-variable.
!
! Input: region  = data of current region 
!        ijk     = ijk-face is being treated
!        i,j,kbeg, i,j,kend = node index boundaries
!        iNOff, ijNOff      = node Offset    
!        nDel    = three components filter width parameter
!        idBeg   = begin variable index to be filtered
!        idEnd   = end variable index to be filtered
!        fVar    = face variable to be filtered
!
! Output: filtVar  = filtered face variable
!
! Notes: Mother routine = LesGenFiltFF.
!
!******************************************************************************
!
! $Id: TURB_floLesGenFiltFFK.F90,v 1.4 2008/12/06 08:44:43 mtcampbe Exp $
!
! Copyright: (c) 2001 by the University of Illinois
!
!******************************************************************************

SUBROUTINE turb_flolesgenfiltffk( region,ijk,ibeg,iend,jbeg,jend,kbeg,kend, &
                                  inoff,ijnoff,ndel,idbeg,idend,fvar,filtvar )

  USE moddatatypes
  USE moddatastruct, ONLY : t_region
  USE modglobal, ONLY     : t_global
  USE modturbulence, ONLY : t_turb
  USE moderror
  USE turb_modparameters
  IMPLICIT NONE

#include "Indexing.h"

! ... parameters
  TYPE(t_region), TARGET :: region
  INTEGER                :: ijk,ibeg,iend,jbeg,jend,kbeg,kend,inoff,ijnoff
  INTEGER                :: ndel(diri:dirk),idbeg,idend
  REAL(RFREAL), POINTER  :: fvar(:,:),filtvar(:,:)

! ... loop variables
  INTEGER :: i, j, k, l, ijkn, ijknb, ijkne

! ... local variables
  CHARACTER(CHRLEN)       :: rcsidentstring
  TYPE(t_global), POINTER :: global
  TYPE(t_turb) , POINTER  :: turb

  INTEGER                 :: ilev
  REAL(RFREAL)            :: tmpb(idbeg:idend),tmpe(idbeg:idend)
  REAL(RFREAL),  POINTER  :: ffcof(:,:)

!******************************************************************************

  rcsidentstring = '$RCSfile: TURB_floLesGenFiltFFK.F90,v $'

  global => region%global
  CALL registerfunction( global,'TURB_FloLesGenFiltFFK',&
  'TURB_floLesGenFiltFFK.F90' )

! get parameters and pointers ------------------------------------------------

  ilev =  region%currLevel
  turb => region%levels(ilev)%turb

! integration over K-direction

  IF (ndel(dirk)==filwidth_zero) THEN

! - no filtering in K-direction is needed and we copy fVar into filtVar

    filtvar = fvar

  ELSEIF ((ndel(dirk)==filwidth_one) .OR. &
          (ndel(dirk)==filwidth_two)) THEN

    IF (ndel(dirk)==filwidth_one) THEN
      IF (ijk==diri) THEN
        ffcof => turb%ffCofk1I
      ELSEIF (ijk==dirj) THEN
        ffcof => turb%ffCofk1J
      ELSEIF (ijk==dirk) THEN
        ffcof => turb%ffCofk1K
      ENDIF
    ELSEIF (ndel(dirk)==filwidth_two) THEN
      IF (ijk==diri) THEN
        ffcof => turb%ffCofk2I
      ELSEIF (ijk==dirj) THEN
        ffcof => turb%ffCofk2J
      ELSEIF (ijk==dirk) THEN
        ffcof => turb%ffCofk2K
      ENDIF
    ENDIF

! - perform integration

    DO k=kbeg,kend
      DO j=jbeg,jend
        DO i=ibeg,iend
          ijkn = indijk(i     ,j     ,k     ,inoff,ijnoff)
          DO l=idbeg,idend
            filtvar(l,ijkn)=ffcof(1,ijkn)*fvar(l,ijkn-ijnoff) + &
                            ffcof(2,ijkn)*fvar(l,ijkn)        + &
                            ffcof(3,ijkn)*fvar(l,ijkn+ijnoff)
          END DO ! l
        ENDDO    ! i
      ENDDO      ! j
    ENDDO        ! k

  ELSEIF (ndel(dirk)==filwidth_four) THEN

    IF (ijk==diri) THEN
      ffcof => turb%ffCofk4I
    ELSEIF (ijk==dirj) THEN
      ffcof => turb%ffCofk4J
    ELSEIF (ijk==dirk) THEN
      ffcof => turb%ffCofk4K
    ENDIF
  
! - perform integration

    DO k=kbeg+1,kend-1           
      DO j=jbeg,jend
        DO i=ibeg,iend
          ijkn = indijk(i     ,j     ,k     ,inoff,ijnoff)
          DO l=idbeg,idend
            filtvar(l,ijkn)=ffcof(1,ijkn)*fvar(l,ijkn-2*ijnoff) + &
                            ffcof(2,ijkn)*fvar(l,ijkn-ijnoff)   + &
                            ffcof(3,ijkn)*fvar(l,ijkn)          + &
                            ffcof(4,ijkn)*fvar(l,ijkn+ijnoff)   + &
                            ffcof(5,ijkn)*fvar(l,ijkn+2*ijnoff)
          ENDDO ! l
        ENDDO   ! i
      ENDDO     ! j
    ENDDO       ! k
  
! - perform integration at the edges

    DO j=jbeg,jend
      DO i=ibeg,iend
        ijknb = indijk(i     ,j     ,kbeg  ,inoff,ijnoff)
        ijkne = indijk(i     ,j     ,kend  ,inoff,ijnoff)
        DO l=idbeg,idend
          tmpb(l) = 2._rfreal*fvar(l,ijknb-ijnoff)-fvar(l,ijknb)
          tmpe(l) = 2._rfreal*fvar(l,ijkne+ijnoff)-fvar(l,ijkne)
          filtvar(l,ijknb)=ffcof(1,ijknb)*tmpb(l)               + &
                           ffcof(2,ijknb)*fvar(l,ijknb-ijnoff)  + &
                           ffcof(3,ijknb)*fvar(l,ijknb)         + &
                           ffcof(4,ijknb)*fvar(l,ijknb+ijnoff)  + &
                           ffcof(5,ijknb)*fvar(l,ijknb+2*ijnoff)
          filtvar(l,ijkne)=ffcof(1,ijkne)*fvar(l,ijkne-2*ijnoff)+ &
                           ffcof(2,ijkne)*fvar(l,ijkne-ijnoff)  + &
                           ffcof(3,ijkne)*fvar(l,ijkne)         + &
                           ffcof(4,ijkne)*fvar(l,ijkne+ijnoff)  + &
                           ffcof(5,ijkne)*tmpe(l) 
        ENDDO ! l
      ENDDO   ! i
    ENDDO     ! j
  ENDIF       ! nDel

! finalize --------------------------------------------------------------------

  CALL deregisterfunction( global )

END SUBROUTINE turb_flolesgenfiltffk

!******************************************************************************
!
! RCS Revision history:
!
! $Log: TURB_floLesGenFiltFFK.F90,v $
! Revision 1.4  2008/12/06 08:44:43  mtcampbe
! Updated license.
!
! Revision 1.3  2008/11/19 22:17:55  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.2  2004/03/12 02:55:36  wasistho
! changed rocturb routine names
!
! Revision 1.1  2004/03/08 23:35:45  wasistho
! changed turb nomenclature
!
! Revision 1.3  2003/08/29 01:42:14  wasistho
! Added TARGET attribute to region variable, since pointers are cached into it
!
! Revision 1.2  2003/05/15 02:57:06  jblazek
! Inlined index function.
!
! Revision 1.1  2002/10/14 23:55:30  wasistho
! Install Rocturb
!
!
!******************************************************************************