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!----------------------------------------------------------------------------!
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
60CONTAINS
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 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
218END MODULE boundary_fixed_mod
integer, parameter fixed
set fixed boundary data
Boundary module for fixed in/outflow conditions.
character(len=32), parameter boundcond_name
subroutine setboundarydata(this, Mesh, Physics, time, pvar)
Applies the fixed boundary condition.
subroutine initboundary_fixed(this, Mesh, Physics, dir, config)
Constructor for fixed boundary conditions.
subroutine finalize(this)
Destructor for fixed boundary conditions.
Dictionary for generic data types.
Definition: common_dict.f90:61
derived class for compound of mesh arrays
basic mesh module
Definition: mesh_base.f90:72
integer, parameter east
named constant for eastern boundary
Definition: mesh_base.f90:101
integer, parameter bottom
named constant for bottom boundary
Definition: mesh_base.f90:101
integer, parameter south
named constant for southern boundary
Definition: mesh_base.f90:101
integer, parameter top
named constant for top boundary
Definition: mesh_base.f90:101
integer, parameter north
named constant for northern boundary
Definition: mesh_base.f90:101
integer, parameter west
named constant for western boundary
Definition: mesh_base.f90:101
Basic physics module.
mesh data structure
Definition: mesh_base.f90:122