boundary_base.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# module: boundary_generic.f90                                              #
!#                                                                           #
!# Copyright (C) 2006-2018                                                   #
!# Tobias Illenseer <tillense@astrophysik.uni-kiel.de>                       #
!# Manuel Jung <mjung@astrophysik.uni-kiel.de>                               #
!# Jannes Klee <jklee@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_base_mod
  USE logging_base_mod
  USE marray_compound_mod
  USE mesh_base_mod
  USE physics_base_mod
  USE common_dict
#ifdef PARALLEL
#ifdef HAVE_MPI_MOD
  USE mpi
#endif
#endif
  IMPLICIT NONE
#ifdef PARALLEL
#ifdef HAVE_MPIF_H
  include 'mpif.h'
#endif
#endif
  !--------------------------------------------------------------------------!
  PRIVATE
  TYPE, ABSTRACT, EXTENDS(logging_base) :: boundary_base
    CLASS(logging_base), ALLOCATABLE   :: direction
!     INTEGER                            :: IMID,        & !< i index of cell in the middle
!                                           JMID,        & !< j index of cell in the middle
!                                           KMID,        & !< j index of cell in the middle
!                                           nohdim         !< dimension of Noh problem
!     LOGICAL                            :: first_call     !< used in far-field bc
!     REAL, DIMENSION(:,:,:), POINTER    :: invr,        & !< inverse distance to center
!                                           Rinv,        & !< Riemann invariants at the boundary
!                                           RinvInf        !< far field Riemann invariants
#ifdef PARALLEL

    REAL, DIMENSION(:,:,:,:), POINTER  :: sendbuf,     & !< send buffer for boundary data
                                          recvbuf
#endif
  CONTAINS
    PROCEDURE :: initboundary
    procedure(setboundarydata), DEFERRED :: setboundarydata
    PROCEDURE :: finalize_base
    procedure(finalize), DEFERRED        :: finalize
    PROCEDURE :: getdirection
  END TYPE boundary_base

  ! exclude interface block from doxygen processing
  abstract INTERFACE
    PURE SUBROUTINE setboundarydata(this,Mesh,Physics,time,pvar)
      IMPORT boundary_base,mesh_base,physics_base,marray_compound
      IMPLICIT NONE
      CLASS(boundary_base),   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
    END SUBROUTINE
    SUBROUTINE finalize(this)
      IMPORT boundary_base
      IMPLICIT NONE
      CLASS(boundary_base),INTENT(INOUT)  :: this
    END SUBROUTINE
  END INTERFACE
  !--------------------------------------------------------------------------!
  CHARACTER(LEN=32), DIMENSION(6), PARAMETER :: &
        direction_name = (/'  west', '  east', ' south', ' north', 'bottom', '   top' /)
  
#ifdef PARALLEL
  INTEGER, PARAMETER :: none            = 0
#endif
  enum, bind(c)
    enumerator :: no_gradients  = z'01', & 
                  periodic      = z'02', & 
                  reflecting    = z'03', & 
                  axis          = z'04', & 
!                   FOLDED        = Z'05', & !< cuts boundary in half and connects
!                                        !<   the two parts (not supported in parallel mode)
                  fixed         = z'06', & 
                  extrapolation = z'07', & 
!                   NOH2D         = Z'08', & !< time-dependent inflow for 2D Noh problem
!                   NOH3D         = Z'09', & !< time-dependent inflow for 3D Noh problem
                  noslip        = z'0A', & 
                  custom        = z'0B', & 
!                   FARFIELD      = Z'0C', & !< uses far-field data and Riemann invariants
                  absorbing     = z'0D', & 
!                   DMR           = Z'0E', & !< ???
                  shearing      = z'0F'    
  END enum
  !--------------------------------------------------------------------------!
  PUBLIC :: &
    ! types
    boundary_base, &
    ! constants
#ifdef PARALLEL
    none, &
#endif
    no_gradients, periodic, reflecting, axis, &
!     FOLDED, &
    fixed, extrapolation, &
!     NOH2D, NOH3D, &
    noslip, custom, &
!     FARFIELD, &
    absorbing, &
!     DMR, &
    shearing
  !--------------------------------------------------------------------------!

CONTAINS

  SUBROUTINE initboundary(this,Mesh,Physics,bctype,bcname,dir,config)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(boundary_base), INTENT(INOUT)       :: this
    CLASS(mesh_base),     INTENT(IN)          :: Mesh
    CLASS(physics_base),  INTENT(IN)          :: Physics
    TYPE(Dict_TYP),       INTENT(IN), POINTER :: config
    INTEGER,              INTENT(IN)          :: bctype,dir
    CHARACTER(LEN=32),    INTENT(IN)          :: bcname
    !------------------------------------------------------------------------!
#ifdef PARALLEL
    INTEGER, PARAMETER    :: strlen = 32
    CHARACTER(LEN=strlen) :: sendbuf
    CHARACTER(LEN=strlen) :: recvbuf
    INTEGER               :: status(MPI_STATUS_SIZE)
    INTEGER               :: ierror
#endif
    !------------------------------------------------------------------------!
    ! set boundary condition
    CALL this%InitLogging(bctype,bcname)
    ALLOCATE(this%direction)
    CALL this%direction%InitLogging(dir,direction_name(dir))
    ! check for wrong direction
    SELECT CASE(dir)
    CASE(west,east,north,south,top,bottom)
       ! ok
    CASE DEFAULT
       CALL this%Error("InitBoundary_common", "Unknown direction")
    END SELECT

!    IF(((Physics%GetType().EQ.EULER2D_ISOIAMT).OR.&
!        (Physics%GetType().EQ.EULER2D_IAMT)).AND. &
!       ((dir.EQ.NORTH).OR.(dir.EQ.SOUTH)).AND.    &
!       (.NOT.((bctype.EQ.PERIODIC)                &
!#ifdef PARALLEL
!              .OR.(bctype.EQ.NONE)                &
!#endif
!              )))                                 &
!      CALL this%Error("InitBoundary_one", "All IAMT Physics need periodic" &
!        // " boundary conditions in NORTH/SOUTH direction")

    ! print some information
#ifdef PARALLEL
    ! send boundary information to the rank 0 process;
    ! we only need this to synchronize the output
    IF (this%GetRank() .EQ. 0 .AND. this%GetRank().EQ.mesh%rank0_boundaries(dir)) THEN
       ! print output without communication
#endif
       CALL this%Info(" BOUNDARY-> condition:         " //  trim(this%direction%GetName()) &
            // " " // trim(this%GetName()), this%GetRank())
#ifdef PARALLEL
    ELSE IF (this%GetRank().EQ.mesh%rank0_boundaries(dir)) THEN
       ! send info to root
       sendbuf = trim(this%direction%GetName())//" "//trim(this%GetName())
       CALL mpi_send(sendbuf,strlen,mpi_character,0, &
                     0,mpi_comm_world,ierror)
    ELSE IF (this%GetRank().EQ.0) THEN
       ! receive input from rank0_boundaries(dir)
       CALL mpi_recv(recvbuf,strlen,mpi_character,mesh%rank0_boundaries(dir),&
                     mpi_any_tag,mpi_comm_world,status,ierror)
       CALL this%Info(" BOUNDARY-> condition:         " // trim(recvbuf),this%GetRank())
    END IF
#endif
  END SUBROUTINE initboundary

  PURE FUNCTION getdirection(this) RESULT(dir)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(boundary_base), INTENT(IN) :: this
    INTEGER                          :: dir
    !------------------------------------------------------------------------!
    dir = this%direction%GetType()
  END FUNCTION getdirection


  SUBROUTINE finalize_base(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(boundary_base),INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    IF (.NOT.this%Initialized()) &
        CALL this%Error("CloseBoundary_one","not initialized")
    DEALLOCATE(this%direction)
  END SUBROUTINE finalize_base

END MODULE boundary_base_mod