boundary_fixed.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# module: boundary_fixed.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_fixed_mod
  USE marray_compound_mod
  USE mesh_base_mod
  USE physics_base_mod
  USE boundary_base_mod
  USE common_dict
  IMPLICIT NONE
  !--------------------------------------------------------------------------!
  PRIVATE
  TYPE, EXTENDS(boundary_base)  :: boundary_fixed
    REAL, DIMENSION(:,:,:,:), ALLOCATABLE  :: data
    LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: fixed
  CONTAINS
    PROCEDURE :: initboundary_fixed
    PROCEDURE :: setboundarydata
    PROCEDURE :: finalize
  END TYPE boundary_fixed
  CHARACTER(LEN=32), PARAMETER  :: boundcond_name = "fixed in/outflow"
  !--------------------------------------------------------------------------!
  PUBLIC :: &
      boundary_fixed
  !--------------------------------------------------------------------------!
 
CONTAINS
 
  SUBROUTINE initboundary_fixed(this,Mesh,Physics,dir,config)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(boundary_fixed) :: this
    CLASS(mesh_base)      :: Mesh
    CLASS(physics_base)   :: Physics
    TYPE(dict_typ),POINTER:: config
    INTEGER               :: dir
    !------------------------------------------------------------------------!
    INTEGER            :: err = 0
    !------------------------------------------------------------------------!
    INTENT(IN)    :: mesh,physics,config
    INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    CALL this%InitBoundary(mesh,physics,fixed,boundcond_name,dir,config)
 
    ! allocate memory for boundary data and mask
    SELECT CASE(this%direction%GetType())
    CASE(west,east)
       ALLOCATE(this%data(mesh%GINUM,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
            this%fixed(mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
            stat=err)
     CASE(south,north)
       ALLOCATE(this%data(mesh%IGMIN:mesh%IGMAX,mesh%GJNUM,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
            this%fixed(mesh%KGMIN:mesh%KGMAX,mesh%IGMIN:mesh%IGMAX,physics%VNUM), &
            stat=err)
     CASE(bottom,top)
       ALLOCATE(this%data(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%GKNUM,physics%VNUM), &
            this%fixed(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,physics%VNUM), &
            stat=err)
    END SELECT
    IF (err.NE.0) THEN
       CALL this%Error("InitBoundary_fixed", "Unable to allocate memory.")
    END IF
    ! fixed(:,:,:) defaults to EXTRAPOLATION everywhere
    this%fixed(:,:,:) = .false.
    this%data(:,:,:,:) = 0.0
  END SUBROUTINE initboundary_fixed
 
 
  SUBROUTINE setboundarydata(this,Mesh,Physics,time,pvar)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(boundary_fixed),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
    !------------------------------------------------------------------------!
    SELECT CASE(this%direction%GetType())
    CASE(west)
       ! UNROLL=Mesh%GNUM would be sufficient, but the compiler does
       ! not know the value of Mesh%GNUM, hence we set UNROLL=4 and
       ! hope that nobody sets Mesh%GNUM to a value greater than 4
!NEC$ UNROLL(4)
       DO i=1,mesh%GINUM
          WHERE(this%fixed(mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:))
             ! set fixed boundary data
             pvar%data4d(mesh%IMIN-i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) = &
                  this%data(i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:)
          ELSEWHERE
             ! first order extrapolation
             pvar%data4d(mesh%IMIN-i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) = &
             (i+1)*pvar%data4d(mesh%IMIN,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) &
             - i*pvar%data4d(mesh%IMIN+1,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:)
          END WHERE
 
       END DO
    CASE(east)
!NEC$ UNROLL(4)
       DO i=1,mesh%GINUM
          WHERE(this%fixed(mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:))
             ! set fixed boundary data
             pvar%data4d(mesh%IMAX+i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) = &
                  this%data(i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:)
          ELSEWHERE
             ! first order extrapolation
             pvar%data4d(mesh%IMAX+i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) = &
                  (i+1)*pvar%data4d(mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) &
                  - i*pvar%data4d(mesh%IMAX-1,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:)
          END WHERE
        END DO
    CASE(south)
!NEC$ UNROLL(4)
       DO j=1,mesh%GJNUM
          WHERE(this%fixed(mesh%KMIN:mesh%KMAX,mesh%IMIN:mesh%IMAX,:))
             ! set fixed boundary data
             pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN-j,mesh%KMIN:mesh%KMAX,:) = &
                  this%data(mesh%IMIN:mesh%IMAX,j,mesh%KMIN:mesh%KMAX,:)
          ELSEWHERE
             ! first order extrapolation
             pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN-j,mesh%KMIN:mesh%KMAX,:) = &
               (j+1)*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN,mesh%KMIN:mesh%KMAX,:) &
               - j*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN+1,mesh%KMIN:mesh%KMAX,:)
          END WHERE
        END DO
    CASE(north)
!NEC$ UNROLL(4)
       DO j=1,mesh%GJNUM
          WHERE(this%fixed(mesh%KMIN:mesh%KMAX,mesh%IMIN:mesh%IMAX,:))
             ! set fixed boundary data
             pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX+j,mesh%KMIN:mesh%KMAX,:) = &
                  this%data(mesh%IMIN:mesh%IMAX,j,mesh%KMIN:mesh%KMAX,:)
          ELSEWHERE
             ! first order extrapolation
             pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX+j,mesh%KMIN:mesh%KMAX,:) = &
                  (j+1)*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX,mesh%KMIN:mesh%KMAX,:) &
                  - j*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX-1,mesh%KMIN:mesh%KMAX,:)
          END WHERE
 
       END DO
    CASE(bottom)
!NEC$ UNROLL(4)
          DO k=1,mesh%GKNUM
            WHERE(this%fixed(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,:))
             ! set fixed boundary data
             pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN-k,:) = &
                  this%data(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,k,:)
          ELSEWHERE
             ! first order extrapolation
             pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN-k,:) = &
                  (k+1)*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN,:) &
                  - k*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN+1,:)
          END WHERE
          END DO
    CASE(top)
!NEC$ UNROLL(4)
       DO k=1,mesh%GKNUM
          WHERE(this%fixed(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,:))
             ! set fixed boundary data
             pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX+k,:) = &
                  this%data(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,k,:)
          ELSEWHERE
             ! first order extrapolation
             pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX+k,:) = &
                  (k+1)*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX,:) &
                  - k*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX-1,:)
          END WHERE
      END DO
    END SELECT
  END SUBROUTINE setboundarydata
 
  SUBROUTINE finalize(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(boundary_fixed),INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    DEALLOCATE(this%data,this%fixed)
    CALL this%Finalize_base()
  END SUBROUTINE finalize
 
END MODULE boundary_fixed_mod