boundary_fixed.f90
Go to the documentation of this file.
1 !#############################################################################
2 !# #
3 !# fosite - 3D hydrodynamical simulation program #
4 !# module: boundary_fixed.f90 #
5 !# #
6 !# Copyright (C) 2006-2014 #
7 !# Tobias Illenseer <tillense@astrophysik.uni-kiel.de> #
8 !# #
9 !# This program is free software; you can redistribute it and/or modify #
10 !# it under the terms of the GNU General Public License as published by #
11 !# the Free Software Foundation; either version 2 of the License, or (at #
12 !# your option) any later version. #
13 !# #
14 !# This program is distributed in the hope that it will be useful, but #
15 !# WITHOUT ANY WARRANTY; without even the implied warranty of #
16 !# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or #
17 !# NON INFRINGEMENT. See the GNU General Public License for more #
18 !# details. #
19 !# #
20 !# You should have received a copy of the GNU General Public License #
21 !# along with this program; if not, write to the Free Software #
22 !# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #
23 !# #
24 !#############################################################################
25 
26 !----------------------------------------------------------------------------!
36 !----------------------------------------------------------------------------!
39  USE mesh_base_mod
42  USE common_dict
43  IMPLICIT NONE
44  !--------------------------------------------------------------------------!
45  PRIVATE
46  TYPE, EXTENDS(boundary_base) :: boundary_fixed
47  REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: data
48  LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: fixed
49  CONTAINS
50  PROCEDURE :: initboundary_fixed
51  PROCEDURE :: setboundarydata
52  PROCEDURE :: finalize
53  END TYPE boundary_fixed
54  CHARACTER(LEN=32), PARAMETER :: boundcond_name = "fixed in/outflow"
55  !--------------------------------------------------------------------------!
56  PUBLIC :: &
58  !--------------------------------------------------------------------------!
59 
60 CONTAINS
61 
63  SUBROUTINE initboundary_fixed(this,Mesh,Physics,dir,config)
64  IMPLICIT NONE
65  !------------------------------------------------------------------------!
66  CLASS(Boundary_fixed) :: this
67  CLASS(Mesh_base) :: Mesh
68  CLASS(Physics_base) :: Physics
69  TYPE(Dict_TYP),POINTER:: config
70  INTEGER :: dir
71  !------------------------------------------------------------------------!
72  INTEGER :: err = 0
73  !------------------------------------------------------------------------!
74  INTENT(IN) :: mesh,physics,config
75  INTENT(INOUT) :: this
76  !------------------------------------------------------------------------!
77  CALL this%InitBoundary(mesh,physics,fixed,boundcond_name,dir,config)
78 
79  ! allocate memory for boundary data and mask
80  SELECT CASE(this%direction%GetType())
81  CASE(west,east)
82  ALLOCATE(this%data(mesh%GINUM,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
83  this%fixed(mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
84  stat=err)
85  CASE(south,north)
86  ALLOCATE(this%data(mesh%IGMIN:mesh%IGMAX,mesh%GJNUM,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
87  this%fixed(mesh%KGMIN:mesh%KGMAX,mesh%IGMIN:mesh%IGMAX,physics%VNUM), &
88  stat=err)
89  CASE(bottom,top)
90  ALLOCATE(this%data(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%GKNUM,physics%VNUM), &
91  this%fixed(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,physics%VNUM), &
92  stat=err)
93  END SELECT
94  IF (err.NE.0) THEN
95  CALL this%Error("InitBoundary_fixed", "Unable to allocate memory.")
96  END IF
97  ! fixed(:,:,:) defaults to EXTRAPOLATION everywhere
98  this%fixed(:,:,:) = .false.
99  this%data(:,:,:,:) = 0.0
100  END SUBROUTINE initboundary_fixed
101 
102 
104  PURE SUBROUTINE setboundarydata(this,Mesh,Physics,time,pvar)
105  IMPLICIT NONE
106  !------------------------------------------------------------------------!
107  CLASS(boundary_fixed),INTENT(INOUT) :: this
108  CLASS(mesh_base),INTENT(IN) :: mesh
109  CLASS(physics_base),INTENT(IN) :: physics
110  REAL,INTENT(IN) :: time
111  CLASS(marray_compound), INTENT(INOUT) :: pvar
112  !------------------------------------------------------------------------!
113  INTEGER :: i,j,k
114  !------------------------------------------------------------------------!
115  SELECT CASE(this%direction%GetType())
116  CASE(west)
117  ! UNROLL=Mesh%GNUM would be sufficient, but the compiler does
118  ! not know the value of Mesh%GNUM, hence we set UNROLL=4 and
119  ! hope that nobody sets Mesh%GNUM to a value greater than 4
120 !NEC$ UNROLL(4)
121  DO i=1,mesh%GINUM
122  WHERE(this%fixed(mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:))
123  ! set fixed boundary data
124  pvar%data4d(mesh%IMIN-i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) = &
125  this%data(i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:)
126  ELSEWHERE
127  ! first order extrapolation
128  pvar%data4d(mesh%IMIN-i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) = &
129  (i+1)*pvar%data4d(mesh%IMIN,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) &
130  - i*pvar%data4d(mesh%IMIN+1,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:)
131  END WHERE
132 
133  END DO
134  CASE(east)
135 !NEC$ UNROLL(4)
136  DO i=1,mesh%GINUM
137  WHERE(this%fixed(mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:))
138  ! set fixed boundary data
139  pvar%data4d(mesh%IMAX+i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) = &
140  this%data(i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:)
141  ELSEWHERE
142  ! first order extrapolation
143  pvar%data4d(mesh%IMAX+i,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) = &
144  (i+1)*pvar%data4d(mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:) &
145  - i*pvar%data4d(mesh%IMAX-1,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,:)
146  END WHERE
147  END DO
148  CASE(south)
149 !NEC$ UNROLL(4)
150  DO j=1,mesh%GJNUM
151  WHERE(this%fixed(mesh%KMIN:mesh%KMAX,mesh%IMIN:mesh%IMAX,:))
152  ! set fixed boundary data
153  pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN-j,mesh%KMIN:mesh%KMAX,:) = &
154  this%data(mesh%IMIN:mesh%IMAX,j,mesh%KMIN:mesh%KMAX,:)
155  ELSEWHERE
156  ! first order extrapolation
157  pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN-j,mesh%KMIN:mesh%KMAX,:) = &
158  (j+1)*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN,mesh%KMIN:mesh%KMAX,:) &
159  - j*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN+1,mesh%KMIN:mesh%KMAX,:)
160  END WHERE
161  END DO
162  CASE(north)
163 !NEC$ UNROLL(4)
164  DO j=1,mesh%GJNUM
165  WHERE(this%fixed(mesh%KMIN:mesh%KMAX,mesh%IMIN:mesh%IMAX,:))
166  ! set fixed boundary data
167  pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX+j,mesh%KMIN:mesh%KMAX,:) = &
168  this%data(mesh%IMIN:mesh%IMAX,j,mesh%KMIN:mesh%KMAX,:)
169  ELSEWHERE
170  ! first order extrapolation
171  pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX+j,mesh%KMIN:mesh%KMAX,:) = &
172  (j+1)*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX,mesh%KMIN:mesh%KMAX,:) &
173  - j*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMAX-1,mesh%KMIN:mesh%KMAX,:)
174  END WHERE
175 
176  END DO
177  CASE(bottom)
178 !NEC$ UNROLL(4)
179  DO k=1,mesh%GKNUM
180  WHERE(this%fixed(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,:))
181  ! set fixed boundary data
182  pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN-k,:) = &
183  this%data(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,k,:)
184  ELSEWHERE
185  ! first order extrapolation
186  pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN-k,:) = &
187  (k+1)*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN,:) &
188  - k*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN+1,:)
189  END WHERE
190  END DO
191  CASE(top)
192 !NEC$ UNROLL(4)
193  DO k=1,mesh%GKNUM
194  WHERE(this%fixed(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,:))
195  ! set fixed boundary data
196  pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX+k,:) = &
197  this%data(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,k,:)
198  ELSEWHERE
199  ! first order extrapolation
200  pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX+k,:) = &
201  (k+1)*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX,:) &
202  - k*pvar%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMAX-1,:)
203  END WHERE
204  END DO
205  END SELECT
206  END SUBROUTINE setboundarydata
207 
209  SUBROUTINE finalize(this)
210  IMPLICIT NONE
211  !------------------------------------------------------------------------!
212  CLASS(Boundary_fixed),INTENT(INOUT) :: this
213  !------------------------------------------------------------------------!
214  DEALLOCATE(this%data,this%fixed)
215  CALL this%Finalize_base()
216  END SUBROUTINE finalize
217 
218 END MODULE boundary_fixed_mod
subroutine finalize(this)
Destructor for fixed boundary conditions.
type(logging_base), save this
derived class for compound of mesh arrays
subroutine initboundary_fixed(this, Mesh, Physics, dir, config)
Constructor for fixed boundary conditions.
character(len=32), parameter boundcond_name
named integer constants for flavour of state vectors
pure subroutine setboundarydata(this, Mesh, Physics, time, pvar)
Applies the fixed boundary condition.
Basic physics module.
Dictionary for generic data types.
Definition: common_dict.f90:61
Boundary module for fixed in/outflow conditions.