boundary_reflecting.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# module: boundary_reflecting.f90                                           #
!#                                                                           #
!# Copyright (C) 2006-2014                                                   #
!# Tobias Illenseer <tillense@astrophysik.uni-kiel.de>                       #
!#                                                                           #
!# This program is free software; you can redistribute it and/or modify      #
!# it under the terms of the GNU General Public License as published by      #
!# the Free Software Foundation; either version 2 of the License, or (at     #
!# your option) any later version.                                           #
!#                                                                           #
!# This program is distributed in the hope that it will be useful, but       #
!# WITHOUT ANY WARRANTY; without even the implied warranty of                #
!# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or        #
!# NON INFRINGEMENT.  See the GNU General Public License for more            #
!# details.                                                                  #
!#                                                                           #
!# You should have received a copy of the GNU General Public License         #
!# along with this program; if not, write to the Free Software               #
!# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                 #
!#                                                                           #
!#############################################################################

!----------------------------------------------------------------------------!
!----------------------------------------------------------------------------!
MODULE boundary_reflecting_mod
  USE marray_compound_mod
  USE mesh_base_mod
  USE boundary_base_mod
  USE physics_base_mod
  USE common_dict
  IMPLICIT NONE
  !--------------------------------------------------------------------------!
  PRIVATE
  TYPE, EXTENDS(boundary_base) :: boundary_reflecting
    LOGICAL, DIMENSION(:), ALLOCATABLE     :: reflx,refly,reflz
  CONTAINS
    PROCEDURE :: initboundary_reflecting
    PROCEDURE :: setboundarydata
    PROCEDURE :: finalize
  END TYPE boundary_reflecting
  CHARACTER(LEN=32), PARAMETER  :: boundcond_name = "reflecting"
  !--------------------------------------------------------------------------!
  PUBLIC :: &
      boundary_reflecting
  !--------------------------------------------------------------------------!

CONTAINS
  !TODO: NOT VERIFIED
  SUBROUTINE initboundary_reflecting(this,Mesh,Physics,dir,config)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(boundary_reflecting), INTENT(INOUT) :: this
    CLASS(physics_base),        INTENT(IN)    :: Physics
    CLASS(mesh_base),           INTENT(IN)    :: Mesh
    TYPE(Dict_TYP), POINTER,    INTENT(IN)    :: config
    INTEGER,                    INTENT(IN)    :: dir
    !------------------------------------------------------------------------!
    INTEGER                                   :: err
    !------------------------------------------------------------------------!
    CALL this%InitBoundary(mesh,physics,reflecting,boundcond_name,dir,config)

    ALLOCATE(                      &
         this%reflX(physics%VNUM), &
         this%reflY(physics%VNUM), &
         this%reflZ(physics%VNUM), &
         stat=err)
    IF (err.NE.0) THEN
       CALL this%Error("InitBoundary_reflecting", "Unable to allocate memory.")
    END IF
    ! this tells us which vars get the opposite sign/vanish at cell faces;
    ! e.g. vertical velocities (depends on the underlying physics)
    CALL physics%ReflectionMasks(mesh,this%reflX,this%reflY,this%reflZ)
  END SUBROUTINE initboundary_reflecting

  PURE SUBROUTINE setboundarydata(this,Mesh,Physics,time,pvar)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(boundary_reflecting), INTENT(INOUT)    :: this
    CLASS(mesh_base),           INTENT(IN)    :: mesh
    CLASS(physics_base),        INTENT(IN)    :: physics
    REAL,                       INTENT(IN)    :: time
    CLASS(marray_compound), INTENT(INOUT)     :: pvar
    !------------------------------------------------------------------------!
    INTEGER                                   :: i,j,k,m
    !------------------------------------------------------------------------!
    SELECT CASE(this%direction%GetType())
    CASE(west)
!NEC$ SHORTLOOP
      DO m=1,physics%VNUM
        IF (this%reflX(m)) THEN
!NEC$ SHORTLOOP
          DO i=1,mesh%GINUM
            pvar%data4d(mesh%IMIN-i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,m) &
              = -pvar%data4d(mesh%IMIN+i-1,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,m)
          END DO
        ELSE
!NEC$ SHORTLOOP
          DO i=1,mesh%GINUM
            pvar%data4d(mesh%IMIN-i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,m) &
              = pvar%data4d(mesh%IMIN+i-1,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,m)
          END DO
        END IF
      END DO
    CASE(east)
!NEC$ SHORTLOOP
      DO m=1,physics%VNUM
        IF (this%reflX(m)) THEN
!NEC$ SHORTLOOP
          DO i=1,mesh%GINUM
            pvar%data4d(mesh%IMAX+i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,m) &
              = -pvar%data4d(mesh%IMAX-i+1,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,m)
          END DO
        ELSE
!NEC$ SHORTLOOP
          DO i=1,mesh%GINUM
            pvar%data4d(mesh%IMAX+i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,m) &
              = pvar%data4d(mesh%IMAX-i+1,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,m)
          END DO
        END IF
      END DO
    CASE(south)
!NEC$ SHORTLOOP
      DO m=1,physics%VNUM
        IF (this%reflY(m)) THEN
!NEC$ SHORTLOOP
          DO j=1,mesh%GJNUM
            pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN-j,mesh%KMIN:mesh%KMAX,m) &
              = -pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN+j-1,mesh%KMIN:mesh%KMAX,m)
          END DO
        ELSE
!NEC$ SHORTLOOP
          DO j=1,mesh%GJNUM
            pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN-j,mesh%KMIN:mesh%KMAX,m) &
              = pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN+j-1,mesh%KMIN:mesh%KMAX,m)
          END DO
        END IF
      END DO
    CASE(north)
!NEC$ SHORTLOOP
      DO m=1,physics%VNUM
        IF (this%reflY(m)) THEN
!NEC$ SHORTLOOP
          DO j=1,mesh%GJNUM
            pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX+j,mesh%KMIN:mesh%KMAX,m) &
              = -pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX-j+1,mesh%KMIN:mesh%KMAX,m)
          END DO
        ELSE
!NEC$ SHORTLOOP
          DO j=1,mesh%GJNUM
            pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX+j,mesh%KMIN:mesh%KMAX,m) &
              = pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX-j+1,mesh%KMIN:mesh%KMAX,m)
          END DO
        END IF
      END DO
    CASE(bottom)
!NEC$ SHORTLOOP
      DO m=1,physics%VNUM
        IF (this%reflZ(m)) THEN
!NEC$ SHORTLOOP
          DO k=1,mesh%GKNUM
            pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN-k,m) &
              = -pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN+k-1,m)
          END DO
        ELSE
!NEC$ SHORTLOOP
          DO k=1,mesh%GKNUM
            pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN-k,m) &
              = pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN+k-1,m)
          END DO
        END IF
      END DO
    CASE(top)
!NEC$ SHORTLOOP
      DO m=1,physics%VNUM
        IF (this%reflZ(m)) THEN
!NEC$ SHORTLOOP
          DO k=1,mesh%GKNUM
            pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX+k,m) &
              = -pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX-k+1,m)
          END DO
        ELSE
!NEC$ SHORTLOOP
          DO k=1,mesh%GKNUM
            pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX+k,m) &
              = pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX-k+1,m)
          END DO
        END IF
      END DO
    END SELECT
  END SUBROUTINE setboundarydata

  SUBROUTINE finalize(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(boundary_reflecting), INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    DEALLOCATE(this%reflX,this%reflY,this%reflZ)
    CALL this%Finalize_base()
  END SUBROUTINE finalize

  END MODULE boundary_reflecting_mod