boundary_generic.f90
Go to the documentation of this file.
1 !#############################################################################
2 !# #
3 !# fosite - 3D hydrodynamical simulation program #
4 !# module: boundary_generic.f90 #
5 !# #
6 !# Copyright (C) 2006-2016 #
7 !# Tobias Illenseer <tillense@astrophysik.uni-kiel.de> #
8 !# Manuel Jung <mjung@astrophysik.uni-kiel.de> #
9 !# Jannes Klee <jklee@astrophysik.uni-kiel.de> #
10 !# #
11 !# This program is free software; you can redistribute it and/or modify #
12 !# it under the terms of the GNU General Public License as published by #
13 !# the Free Software Foundation; either version 2 of the License, or (at #
14 !# your option) any later version. #
15 !# #
16 !# This program is distributed in the hope that it will be useful, but #
17 !# WITHOUT ANY WARRANTY; without even the implied warranty of #
18 !# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or #
19 !# NON INFRINGEMENT. See the GNU General Public License for more #
20 !# details. #
21 !# #
22 !# You should have received a copy of the GNU General Public License #
23 !# along with this program; if not, write to the Free Software #
24 !# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #
25 !# #
26 !#############################################################################
34 !----------------------------------------------------------------------------!
43 !----------------------------------------------------------------------------!
44 MODULE boundary_generic_mod
45  USE logging_base_mod
46  USE marray_compound_mod
47  USE mesh_base_mod
48  USE boundary_base_mod
49  USE boundary_custom_mod
50  USE boundary_reflecting_mod
51  USE boundary_nogradients_mod
52  USE boundary_periodic_mod
53  USE boundary_inner_mod
54  USE boundary_axis_mod
55  USE boundary_absorbing_mod
56  USE boundary_fixed_mod
57  USE boundary_noslip_mod
58  USE boundary_shearing_mod
59  USE physics_base_mod
60  USE common_dict
61  !--------------------------------------------------------------------------!
62  TYPE, PRIVATE :: boundary_p
63  CLASS(boundary_base), ALLOCATABLE :: p
64  END TYPE
65 
66  TYPE, EXTENDS(logging_base) :: boundary_generic
68  TYPE(boundary_p) :: boundary(6)
69  CONTAINS
70  PROCEDURE :: initboundary
71  PROCEDURE :: centerboundary
72  PROCEDURE :: setcorneredges
73 #ifdef PARALLEL
74  PROCEDURE :: mpiboundarycommunication
75  PROCEDURE :: initboundary_mpi
76 #endif
77  PROCEDURE :: finalize
78  END TYPE boundary_generic
79  !--------------------------------------------------------------------------!
80  PUBLIC :: &
81  ! types
82  boundary_base, boundary_generic, new_boundary
83  ! constants
84  PRIVATE :: initboundary, centerboundary, finalize
85  !--------------------------------------------------------------------------!
86 
87 CONTAINS
88 
89  SUBROUTINE new_boundary(Boundary,Mesh,Physics,config,IO)
90  IMPLICIT NONE
91  !------------------------------------------------------------------------!
92  CLASS(boundary_generic), ALLOCATABLE :: boundary
93  CLASS(mesh_base), INTENT(INOUT) :: mesh
94  CLASS(physics_base), INTENT(IN) :: physics
95  TYPE(dict_typ), POINTER :: config,io
96  !------------------------------------------------------------------------!
97  ALLOCATE(boundary)
98  CALL boundary%InitBoundary(mesh,physics,config,io)
99  END SUBROUTINE
100 
101  SUBROUTINE initboundary(this,Mesh,Physics,config,IO)
102  IMPLICIT NONE
103  !------------------------------------------------------------------------!
104  CLASS(boundary_generic), INTENT(INOUT) :: this
105  CLASS(mesh_base), INTENT(INOUT) :: mesh
106  CLASS(physics_base), INTENT(IN) :: physics
107  TYPE(dict_typ), POINTER :: config,io
108  INTEGER :: western, eastern, southern, northern, bottomer, topper
109  !------------------------------------------------------------------------!
110  INTEGER :: new(6)
111  INTEGER :: western_std, eastern_std, northern_std, southern_std, &
112  topper_std, bottomer_std
113  LOGICAL, DIMENSION(3) :: periods = .false.
114  INTEGER :: dir
115  !------------------------------------------------------------------------!
116  IF (.NOT.physics%Initialized().OR..NOT.mesh%Initialized()) &
117  CALL this%Error("InitBoundary","physics and/or mesh module uninitialized")
118 
119  ! check for shearingsheet standard boundaries
120  western_std = 0
121  eastern_std = 0
122  northern_std = 0
123  southern_std = 0
124  bottomer_std = 0
125  topper_std = 0
126  IF (mesh%shear_dir.EQ.1) THEN
127  western_std = periodic
128  eastern_std = periodic
129  southern_std = shearing
130  northern_std = shearing
131  bottomer_std = periodic
132  topper_std = periodic
133  ELSE IF (mesh%shear_dir.EQ.2) THEN
134  western_std = shearing
135  eastern_std = shearing
136  southern_std = periodic
137  northern_std = periodic
138  bottomer_std = periodic
139  topper_std = periodic
140  END IF
141 
142  CALL getattr(config, "western", western, western_std)
143  CALL getattr(config, "eastern", eastern, eastern_std)
144  CALL getattr(config, "southern", southern, northern_std)
145  CALL getattr(config, "northern", northern, southern_std)
146  CALL getattr(config, "bottomer", bottomer, bottomer_std)
147  CALL getattr(config, "topper", topper, topper_std)
148 
149  new(west) = western
150  new(east) = eastern
151  new(south) = southern
152  new(north) = northern
153  new(bottom) = bottomer
154  new(top) = topper
155 
156 #ifdef PARALLEL
157  ! define inner connections, where boundaries are no true ones
158  IF (mesh%mycoords(1).NE.0) new(west) = none
159  IF (mesh%mycoords(1).NE.mesh%dims(1)-1) new(east) = none
160  IF (mesh%mycoords(2).NE.0) new(south) = none
161  IF (mesh%mycoords(2).NE.mesh%dims(2)-1) new(north) = none
162  IF (mesh%mycoords(3).NE.0) new(bottom) = none
163  IF (mesh%mycoords(3).NE.mesh%dims(3)-1) new(top) = none
164 #endif
165 
166  ! Check for correct shifting and boundaries
167  IF (western.EQ.shearing.AND.eastern.EQ.shearing) THEN
168  IF (.NOT.mesh%shear_dir.EQ.2) &
169  CALL this%Error("InitBoundary", &
170  "Please apply shifting in second dimension, when applying shearing boundaries at western/eastern.")
171 #ifdef PARALLEL
172  CALL this%Error("InitBoundary", &
173  "Parallel mode is not allowed with shearing in West-East direction.")
174 #endif
175  ELSE IF (southern.EQ.shearing.AND.northern.EQ.shearing) THEN
176  IF (.NOT.mesh%shear_dir.EQ.1) &
177  CALL this%Error("InitBoundary", &
178  "Please apply shifting in first dimension, when applying shearing boundaries at northern/southern.")
179  ELSE IF (bottomer.EQ.shearing.AND.topper.EQ.shearing) THEN
180  CALL this%Error("InitBoundary", &
181  "shifting in topper/bottomer direction not allowed.")
182  END IF
183 
184  ! initialize every boundary
185  ! IMPORTANT: do this before anything else
186  DO dir=west,top
187  SELECT CASE(new(dir))
188  CASE(absorbing)
189  ALLOCATE(boundary_absorbing::this%Boundary(dir)%p)
190  CASE(axis)
191  ALLOCATE(boundary_axis::this%Boundary(dir)%p)
192  CASE(custom)
193  ALLOCATE(boundary_custom::this%Boundary(dir)%p)
194  CASE(fixed)
195  ALLOCATE(boundary_fixed::this%Boundary(dir)%p)
196  CASE(no_gradients)
197  ALLOCATE(boundary_nogradients::this%Boundary(dir)%p)
198  CASE(noslip)
199  ALLOCATE(boundary_noslip::this%boundary(dir)%p)
200  CASE(periodic)
201  ALLOCATE(boundary_periodic::this%Boundary(dir)%p)
202  CASE(reflecting)
203  ALLOCATE(boundary_reflecting::this%Boundary(dir)%p)
204  CASE(shearing)
205  ALLOCATE(boundary_shearing::this%Boundary(dir)%p)
206 #ifdef PARALLEL
207  CASE(none)
208  ALLOCATE(boundary_inner::this%Boundary(dir)%p)
209 #endif
210  END SELECT
211 
212  SELECT TYPE(obj => this%Boundary(dir)%p)
213  TYPE IS (boundary_absorbing)
214  CALL obj%InitBoundary_absorbing(mesh,physics,dir,config)
215  TYPE IS (boundary_axis)
216  CALL obj%InitBoundary_axis(mesh,physics,dir,config)
217  TYPE IS (boundary_custom)
218  CALL obj%InitBoundary_custom(mesh,physics,dir,config)
219  TYPE IS (boundary_fixed)
220  CALL obj%InitBoundary_fixed(mesh,physics,dir,config)
221  TYPE IS (boundary_nogradients)
222  CALL obj%InitBoundary_nogradients(mesh,physics,dir,config)
223  TYPE IS (boundary_noslip)
224  CALL obj%InitBoundary_noslip(mesh,physics,dir,config)
225  TYPE IS (boundary_periodic)
226  CALL obj%InitBoundary_periodic(mesh,physics,dir,config)
227  TYPE IS (boundary_reflecting)
228  CALL obj%InitBoundary_reflecting(mesh,physics,dir,config)
229  TYPE IS (boundary_shearing)
230  CALL obj%InitBoundary_shearing(mesh,physics,dir,config)
231 #ifdef PARALLEL
232  TYPE IS (boundary_inner)
233  CALL obj%InitBoundary_inner(mesh,physics,dir,config)
234 #endif
235  END SELECT
236  END DO
237 
238  ! check periodicity
239  IF ((western.EQ.periodic.AND.eastern.EQ.periodic) .OR. &
240  (western.EQ.shearing.AND.eastern.EQ.shearing)) THEN
241  periods(1) = .true.
242  ELSE IF (western.EQ.periodic.NEQV.eastern.EQ.periodic) THEN
243  CALL this%boundary(west)%p%Error("InitBoundary", &
244  "Opposite boundary should be periodic.")
245  ELSE IF (western.EQ.shearing.NEQV.eastern.EQ.shearing) THEN
246  CALL this%boundary(west)%p%Error("InitBoundary", &
247  "Opposite boundary should be shearing.")
248  END IF
249  IF ((southern.EQ.periodic.AND.northern.EQ.periodic) .OR. &
250  (southern.EQ.shearing.AND.northern.EQ.shearing)) THEN
251  periods(2) = .true.
252  ELSE IF (southern.EQ.periodic.NEQV.northern.EQ.periodic) THEN
253  CALL this%boundary(south)%p%Error("InitBoundary", &
254  "Opposite boundary should be periodic.")
255  ELSE IF (southern.EQ.shearing.NEQV.northern.EQ.shearing) THEN
256  CALL this%boundary(south)%p%Error("InitBoundary", &
257  "Opposite boundary should be shearing.")
258  END IF
259  IF ((bottomer.EQ.periodic.AND.topper.EQ.periodic) .OR. &
260  (bottomer.EQ.shearing.AND.topper.EQ.shearing)) THEN
261  periods(3) = .true.
262  ELSE IF (bottomer.EQ.periodic.NEQV.topper.EQ.periodic) THEN
263  CALL this%boundary(bottom)%p%Error("InitBoundary", &
264  "Opposite boundary should be periodic.")
265  ELSE IF (bottomer.EQ.shearing.NEQV.topper.EQ.shearing) THEN
266  CALL this%boundary(bottom)%p%Error("InitBoundary", &
267  "Opposite boundary should be shearing.")
268  END IF
269 
270 #ifdef PARALLEL
271  CALL this%InitBoundary_MPI(mesh,physics,periods)
272 #endif
273 
274  END SUBROUTINE initboundary
275 
276 
278  SUBROUTINE centerboundary(this,Mesh,Physics,time,pvar,cvar)
279  USE boundary_shearing_mod, ONLY : boundary_shearing
280  IMPLICIT NONE
281  !------------------------------------------------------------------------!
282  CLASS(boundary_generic),INTENT(INOUT) :: this
283  CLASS(mesh_base), INTENT(IN) :: mesh
284  CLASS(physics_base), INTENT(IN) :: physics
285  REAL, INTENT(IN) :: time
286  CLASS(marray_compound), INTENT(INOUT) :: pvar, cvar
287  !------------------------------------------------------------------------!
288  CALL physics%Convert2Primitive(mesh%IMIN,mesh%IMAX,mesh%JMIN, &
289  mesh%JMAX,mesh%KMIN,mesh%KMAX,cvar,pvar)
290 
291  this%err = 0
292  ! set physical boundary conditions at western and eastern boundaries
293  IF (mesh%INUM.GT.1) THEN
294  CALL this%Boundary(west)%p%SetBoundaryData(mesh,physics,time,pvar)
295  IF (this%err.GT.0) CALL this%Error("boundary_generic::CenterBoundary", &
296  "western boundary condition failed")
297  CALL this%Boundary(east)%p%SetBoundaryData(mesh,physics,time,pvar)
298  IF (this%err.GT.0) CALL this%Error("boundary_generic::CenterBoundary", &
299  "eastern boundary condition failed")
300  END IF
301 
302  ! set physical boundary conditions at southern and northern boundaries
303  !
304  ! Here an extra case for parallel execution is handled, when shearing
305  ! boundaries are applied in northern/southern direction. The application
306  ! of the boundary conditions is done after the MPI communication, because
307  ! the shearing boundaries need to first apply periodic boundary conditions.
308  ! This is done MPI below across the computational domains.
309 #ifdef PARALLEL
310  SELECT TYPE(bound1 => this%Boundary(south)%p)
311  TYPE IS (boundary_shearing)
312  ! Apply shearing boundaries after MPI communication. Compare with
313  ! code passage further below.
314  CLASS DEFAULT
315  IF (mesh%JNUM.GT.1) THEN
316  CALL this%Boundary(south)%p%SetBoundaryData(mesh,physics,time,pvar)
317  IF (this%err.GT.0) CALL this%Error("boundary_generic::CenterBoundary", &
318  "southern boundary condition failed")
319  END IF
320  END SELECT
321 
322  SELECT TYPE(bound2 => this%Boundary(north)%p)
323  TYPE IS (boundary_shearing)
324  ! Apply shearing boundaries after MPI communication. Compare with
325  ! code passage further below.
326  CLASS DEFAULT
327  IF (mesh%JNUM.GT.1) THEN
328  CALL this%Boundary(north)%p%SetBoundaryData(mesh,physics,time,pvar)
329  IF (this%err.GT.0) CALL this%Error("boundary_generic::CenterBoundary", &
330  "northern boundary condition failed")
331  END IF
332  END SELECT
333 #else
334  IF (mesh%JNUM.GT.1) THEN
335  CALL this%Boundary(south)%p%SetBoundaryData(mesh,physics,time,pvar)
336  IF (this%err.GT.0) CALL this%Error("boundary_generic::CenterBoundary", &
337  "southern boundary condition failed")
338  CALL this%Boundary(north)%p%SetBoundaryData(mesh,physics,time,pvar)
339  IF (this%err.GT.0) CALL this%Error("boundary_generic::CenterBoundary", &
340  "northern boundary condition failed")
341  END IF
342 #endif
343 
344  ! set physical boundary conditions at top and bottom boundaries
345  IF (mesh%KNUM.GT.1) THEN
346  CALL this%Boundary(bottom)%p%SetBoundaryData(mesh,physics,time,pvar)
347  IF (this%err.GT.0) CALL this%Error("boundary_generic::CenterBoundary", &
348  "bottom boundary condition failed")
349  CALL this%Boundary(top)%p%SetBoundaryData(mesh,physics,time,pvar)
350  IF (this%err.GT.0) CALL this%Error("boundary_generic::CenterBoundary", &
351  "top boundary condition failed")
352  END IF
353 
354 #ifdef PARALLEL
355  CALL mpiboundarycommunication(this,mesh,physics,pvar%data4d)
356 #endif
357 
358 #ifdef PARALLEL
359  ! set physical boundary conditions at southern and northern boundaries
360  ! Here an extra case for parallel execution is handled. When shearing
361  ! boundaries are applied, periodic boundaries are assumed.
362  SELECT TYPE(bound1 => this%Boundary(south)%p)
363  TYPE IS (boundary_shearing)
364  IF (mesh%JNUM.GT.1) THEN
365  CALL this%Boundary(south)%p%SetBoundaryData(mesh,physics,time,pvar)
366  END IF
367  CLASS DEFAULT
368  ! do nothing
369  END SELECT
370  SELECT TYPE(bound2 => this%Boundary(north)%p)
371  TYPE IS (boundary_shearing)
372  IF (mesh%JNUM.GT.1) THEN
373  CALL this%Boundary(north)%p%SetBoundaryData(mesh,physics,time,pvar)
374  END IF
375  CLASS DEFAULT
376  ! do nothing
377  END SELECT
378 #endif
379 
380  CALL setcorneredges(this,mesh,physics,pvar%data4d)
381 
382  ! convert primitive variables in ghost cells
383  IF (mesh%INUM.GT.1) THEN
384  CALL physics%Convert2Conservative(mesh%IGMIN,mesh%IMIN-mesh%IP1, &
385  mesh%JGMIN,mesh%JGMAX,mesh%KGMIN,mesh%KGMAX,pvar,cvar)
386  CALL physics%Convert2Conservative(mesh%IMAX+mesh%IP1,mesh%IGMAX, &
387  mesh%JGMIN,mesh%JGMAX,mesh%KGMIN,mesh%KGMAX,pvar,cvar)
388  END IF
389  IF (mesh%JNUM.GT.1) THEN
390  CALL physics%Convert2Conservative(mesh%IMIN,mesh%IMAX, &
391  mesh%JGMIN,mesh%JMIN-mesh%JP1,mesh%KGMIN,mesh%KGMAX,pvar,cvar)
392  CALL physics%Convert2Conservative(mesh%IMIN,mesh%IMAX, &
393  mesh%JMAX+mesh%JP1,mesh%JGMAX,mesh%KGMIN,mesh%KGMAX,pvar,cvar)
394  END IF
395  IF (mesh%KNUM.GT.1) THEN
396  CALL physics%Convert2Conservative(mesh%IMIN,mesh%IMAX, &
397  mesh%JMIN,mesh%JMAX,mesh%KGMIN,mesh%KMIN-mesh%KP1,pvar,cvar)
398  CALL physics%Convert2Conservative(mesh%IMIN,mesh%IMAX, &
399  mesh%JMIN,mesh%JMAX,mesh%KMAX+mesh%KP1,mesh%KGMAX,pvar,cvar)
400  END IF
401  END SUBROUTINE centerboundary
402 
403 
417  SUBROUTINE setcorneredges(this,Mesh,Physics,pvar)
418  IMPLICIT NONE
419  !------------------------------------------------------------------------!
420  CLASS(boundary_generic),INTENT(INOUT) :: this
421  CLASS(mesh_base), INTENT(IN) :: Mesh
422  CLASS(physics_base), INTENT(IN) :: Physics
423  REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX,Physics%VNUM), &
424  INTENT(INOUT) :: pvar
425  !------------------------------------------------------------------------!
426  INTEGER :: i,j,k
427  !------------------------------------------------------------------------!
428  IF ((mesh%INUM.NE.1.AND.mesh%JNUM.NE.1.AND.mesh%KNUM.EQ.1).OR. &
429  (mesh%INUM.NE.1.AND.mesh%JNUM.NE.1.AND.mesh%KNUM.NE.1)) THEN
430 
431  ! south-west
432 #ifdef PARALLEL
433  IF(mesh%mycoords(1).EQ.0.AND.mesh%mycoords(2).EQ.0) THEN
434 #endif
435 !NEC$ SHORTLOOP
436  DO j=1,mesh%GNUM
437 !NEC$ SHORTLOOP
438  DO i=j+1,mesh%GNUM
439  pvar(mesh%IMIN-i,mesh%JMIN-j,:,:) = pvar(mesh%IMIN-i,mesh%JMIN-j+1,:,:)
440  pvar(mesh%IMIN-j,mesh%JMIN-i,:,:) = pvar(mesh%IMIN-j+1,mesh%JMIN-i,:,:)
441  END DO
442  pvar(mesh%IMIN-j,mesh%JMIN-j,:,:) = 0.5 * (pvar(mesh%IMIN-j,mesh%JMIN,:,:) &
443  + pvar(mesh%IMIN,mesh%JMIN-j,:,:))
444  END DO
445 #ifdef PARALLEL
446  END IF
447 #endif
448  ! south-east
449 #ifdef PARALLEL
450  IF(mesh%mycoords(1).EQ.mesh%dims(1)-1.AND.mesh%mycoords(2).EQ.0) THEN
451 #endif
452 !NEC$ SHORTLOOP
453  DO j=1,mesh%GNUM
454 !NEC$ SHORTLOOP
455  DO i=j+1,mesh%GNUM
456  pvar(mesh%IMAX+i,mesh%JMIN-j,:,:) = pvar(mesh%IMAX+i,mesh%JMIN-j+1,:,:)
457  pvar(mesh%IMAX+j,mesh%JMIN-i,:,:) = pvar(mesh%IMAX+j-1,mesh%JMIN-i,:,:)
458  END DO
459  pvar(mesh%IMAX+j,mesh%JMIN-j,:,:) = 0.5 * (pvar(mesh%IMAX+j,mesh%JMIN,:,:) &
460  + pvar(mesh%IMAX,mesh%JMIN-j,:,:))
461  END DO
462 #ifdef PARALLEL
463  END IF
464 #endif
465  ! north-west
466 #ifdef PARALLEL
467  IF(mesh%mycoords(1).EQ.0.AND.mesh%mycoords(2).EQ.mesh%dims(2)-1) THEN
468 #endif
469 !NEC$ SHORTLOOP
470  DO j=1,mesh%GNUM
471 !NEC$ SHORTLOOP
472  DO i=j+1,mesh%GNUM
473  pvar(mesh%IMIN-i,mesh%JMAX+j,:,:) = pvar(mesh%IMIN-i,mesh%JMAX+j-1,:,:)
474  pvar(mesh%IMIN-j,mesh%JMAX+i,:,:) = pvar(mesh%IMIN-j+1,mesh%JMAX+i,:,:)
475  END DO
476  pvar(mesh%IMIN-j,mesh%JMAX+j,:,:) = 0.5 * (pvar(mesh%IMIN-j,mesh%JMAX,:,:) &
477  + pvar(mesh%IMIN,mesh%JMAX+j,:,:))
478  END DO
479 #ifdef PARALLEL
480  END IF
481 #endif
482 
483  ! north-east
484 #ifdef PARALLEL
485  IF(mesh%mycoords(1).EQ.mesh%dims(1)-1.AND.mesh%mycoords(2).EQ.mesh%dims(2)-1) THEN
486 #endif
487 !NEC$ SHORTLOOP
488  DO j=1,mesh%GNUM
489 !NEC$ SHORTLOOP
490  DO i=j+1,mesh%GNUM
491  pvar(mesh%IMAX+i,mesh%JMAX+j,:,:) = pvar(mesh%IMAX+i,mesh%JMAX+j-1,:,:)
492  pvar(mesh%IMAX+j,mesh%JMAX+i,:,:) = pvar(mesh%IMAX+j-1,mesh%JMAX+i,:,:)
493  END DO
494  pvar(mesh%IMAX+j,mesh%JMAX+j,:,:) = 0.5 * (pvar(mesh%IMAX+j,mesh%JMAX,:,:) &
495  + pvar(mesh%IMAX,mesh%JMAX+j,:,:))
496  END DO
497 #ifdef PARALLEL
498  END IF
499 #endif
500  END IF
501 
502  IF ((mesh%INUM.NE.1.AND.mesh%JNUM.EQ.1.AND.mesh%KNUM.NE.1).OR. &
503  (mesh%INUM.NE.1.AND.mesh%JNUM.NE.1.AND.mesh%KNUM.NE.1)) THEN
504 
505  ! bottom-west
506 #ifdef PARALLEL
507  IF(mesh%mycoords(1).EQ.0.AND.mesh%mycoords(3).EQ.0) THEN
508 #endif
509 !NEC$ SHORTLOOP
510  DO i=1,mesh%GNUM
511 !NEC$ SHORTLOOP
512  DO k=i+1,mesh%GNUM
513  pvar(mesh%IMIN-i,:,mesh%KMIN-k,:) = pvar(mesh%IMIN-i+1,:,mesh%KMIN-k,:)
514  pvar(mesh%IMIN-k,:,mesh%KMIN-i,:) = pvar(mesh%IMIN-k,:,mesh%KMIN-i+1,:)
515  END DO
516  pvar(mesh%IMIN-i,:,mesh%KMIN-i,:) = 0.5 * (pvar(mesh%IMIN-i,:,mesh%KMIN,:) &
517  + pvar(mesh%IMIN,:,mesh%KMIN-i,:))
518  END DO
519 #ifdef PARALLEL
520  END IF
521 #endif
522  ! bottom-east
523 #ifdef PARALLEL
524  IF(mesh%mycoords(1).EQ.mesh%dims(1)-1.AND.mesh%mycoords(3).EQ.0) THEN
525 #endif
526 !NEC$ SHORTLOOP
527  DO i=1,mesh%GNUM
528 !NEC$ SHORTLOOP
529  DO k=i+1,mesh%GNUM
530  pvar(mesh%IMAX+i,:,mesh%KMIN-k,:) = pvar(mesh%IMAX+i-1,:,mesh%KMIN-k,:)
531  pvar(mesh%IMAX+k,:,mesh%KMIN-i,:) = pvar(mesh%IMAX+k,:,mesh%KMIN-i+1,:)
532  END DO
533  pvar(mesh%IMAX+i,:,mesh%KMIN-i,:) = 0.5 * (pvar(mesh%IMAX,:,mesh%KMIN-i,:) &
534  + pvar(mesh%IMAX+i,:,mesh%KMIN,:))
535  END DO
536 #ifdef PARALLEL
537  END IF
538 #endif
539 
540  ! top-west
541 #ifdef PARALLEL
542  IF(mesh%mycoords(1).EQ.0.AND.mesh%mycoords(3).EQ.mesh%dims(3)-1) THEN
543 #endif
544 !NEC$ SHORTLOOP
545  DO i=1,mesh%GNUM
546 !NEC$ SHORTLOOP
547  DO k=i+1,mesh%GNUM
548  pvar(mesh%IMIN-i,:,mesh%KMAX+k,:) = pvar(mesh%IMIN-i+1,:,mesh%KMAX+k,:)
549  pvar(mesh%IMIN-k,:,mesh%KMAX+i,:) = pvar(mesh%IMIN-k,:,mesh%KMAX+i-1,:)
550  END DO
551  pvar(mesh%IMIN-i,:,mesh%KMAX+i,:) = 0.5 * (pvar(mesh%IMIN,:,mesh%KMAX+i,:) &
552  + pvar(mesh%IMIN-i,:,mesh%KMAX,:))
553  END DO
554 #ifdef PARALLEL
555  END IF
556 #endif
557 
558  ! top-east
559 #ifdef PARALLEL
560  IF(mesh%mycoords(1).EQ.mesh%dims(1)-1.AND.mesh%mycoords(3).EQ.mesh%dims(3)-1) THEN
561 #endif
562 !NEC$ SHORTLOOP
563  DO i=1,mesh%GNUM
564 !NEC$ SHORTLOOP
565  DO k=i+1,mesh%GNUM
566  pvar(mesh%IMAX+i,:,mesh%KMAX+k,:) = pvar(mesh%IMAX+i-1,:,mesh%KMAX+k,:)
567  pvar(mesh%IMAX+k,:,mesh%KMAX+i,:) = pvar(mesh%IMAX+k,:,mesh%KMAX+i-1,:)
568  END DO
569  pvar(mesh%IMAX+i,:,mesh%KMAX+i,:) = 0.5 * (pvar(mesh%IMAX,:,mesh%KMAX+i,:) &
570  + pvar(mesh%IMAX+i,:,mesh%KMAX,:))
571  END DO
572 #ifdef PARALLEL
573  END IF
574 #endif
575  END IF
576 
577  IF ((mesh%INUM.EQ.1.AND.mesh%JNUM.NE.1.AND.mesh%KNUM.NE.1).OR. &
578  (mesh%INUM.NE.1.AND.mesh%JNUM.NE.1.AND.mesh%KNUM.NE.1)) THEN
579 
580  ! bottom-south
581 #ifdef PARALLEL
582  IF(mesh%mycoords(2).EQ.0.AND.mesh%mycoords(3).EQ.0) THEN
583 #endif
584 !NEC$ SHORTLOOP
585  DO j=1,mesh%GNUM
586 !NEC$ SHORTLOOP
587  DO k=j+1,mesh%GNUM
588  pvar(:,mesh%JMIN-j,mesh%KMIN-k,:) = pvar(:,mesh%JMIN-j+1,mesh%KMIN-k,:)
589  pvar(:,mesh%JMIN-k,mesh%KMIN-j,:) = pvar(:,mesh%JMIN-k,mesh%KMIN-j+1,:)
590  END DO
591  pvar(:,mesh%JMIN-j,mesh%KMIN-j,:) = 0.5 * (pvar(:,mesh%JMIN,mesh%KMIN-j,:) &
592  + pvar(:,mesh%JMIN-j,mesh%KMIN,:))
593  END DO
594 #ifdef PARALLEL
595  END IF
596 #endif
597 
598  ! bottom-north
599 #ifdef PARALLEL
600  IF(mesh%mycoords(2).EQ.mesh%dims(2)-1.AND.mesh%mycoords(3).EQ.0) THEN
601 #endif
602 !NEC$ SHORTLOOP
603  DO j=1,mesh%GNUM
604 !NEC$ SHORTLOOP
605  DO k=j+1,mesh%GNUM
606  pvar(:,mesh%JMAX+j,mesh%KMIN-k,:) = pvar(:,mesh%JMAX+j-1,mesh%KMIN-k,:)
607  pvar(:,mesh%JMAX+k,mesh%KMIN-j,:) = pvar(:,mesh%JMAX+k,mesh%KMIN-j+1,:)
608  END DO
609 !NEC$ IVDEP
610  pvar(:,mesh%JMAX+j,mesh%KMIN-j,:) = 0.5 * (pvar(:,mesh%JMAX,mesh%KMIN-j,:) &
611  + pvar(:,mesh%JMAX+j,mesh%KMIN,:))
612  END DO
613 #ifdef PARALLEL
614  END IF
615 #endif
616 
617  ! top-south
618 #ifdef PARALLEL
619  IF(mesh%mycoords(2).EQ.0.AND.mesh%mycoords(3).EQ.mesh%dims(3)-1) THEN
620 #endif
621 !NEC$ SHORTLOOP
622  DO j=1,mesh%GNUM
623 !NEC$ SHORTLOOP
624  DO k=j+1,mesh%GNUM
625  pvar(:,mesh%JMIN-j,mesh%KMAX+k,:) = pvar(:,mesh%JMIN-j+1,mesh%KMAX+k,:)
626  pvar(:,mesh%JMIN-k,mesh%KMAX+j,:) = pvar(:,mesh%JMIN-k,mesh%KMAX+j-1,:)
627  END DO
628  pvar(:,mesh%JMIN-j,mesh%KMAX+j,:) = 0.5 * (pvar(:,mesh%JMIN,mesh%KMAX+j,:) &
629  + pvar(:,mesh%JMIN-j,mesh%KMAX,:))
630  END DO
631 #ifdef PARALLEL
632  END IF
633 #endif
634 
635  ! top-north
636 #ifdef PARALLEL
637  IF(mesh%mycoords(2).EQ.mesh%dims(2)-1.AND.mesh%mycoords(3).EQ.mesh%dims(3)-1) THEN
638 #endif
639 !NEC$ SHORTLOOP
640  DO j=1,mesh%GNUM
641 !NEC$ SHORTLOOP
642  DO k=j+1,mesh%GNUM
643  pvar(:,mesh%JMAX+j,mesh%KMAX+k,:) = pvar(:,mesh%JMAX+j-1,mesh%KMAX+k,:)
644  pvar(:,mesh%JMAX+k,mesh%KMAX+j,:) = pvar(:,mesh%JMAX+k,mesh%KMAX+j-1,:)
645  END DO
646  pvar(:,mesh%JMAX+j,mesh%KMAX+j,:) = 0.5 * (pvar(:,mesh%JMAX,mesh%KMAX+j,:) &
647  + pvar(:,mesh%JMAX+j,mesh%KMAX,:))
648  END DO
649 #ifdef PARALLEL
650  END IF
651 #endif
652  END IF
653 
654  ! Set corner cells (only 3D)
655  IF (mesh%INUM.NE.1.AND.mesh%JNUM.NE.1.AND.mesh%KNUM.NE.1) THEN
656 #ifdef PARALLEL
657  IF(mesh%mycoords(1).EQ.0.AND.mesh%mycoords(2).EQ.0.AND.mesh%mycoords(3).EQ.0) THEN
658 #endif
659 !NEC$ SHORTLOOP
660  DO i=1,mesh%GNUM
661  pvar(mesh%IMIN-i,mesh%JMIN-i,mesh%KMIN-i,:) = (pvar(mesh%IMIN-i,mesh%JMIN,mesh%KMIN,:) &
662  + pvar(mesh%IMIN,mesh%JMIN-i,mesh%KMIN,:) + pvar(mesh%IMIN,mesh%JMIN,mesh%KMIN-i,:))/3.0
663  END DO
664 #ifdef PARALLEL
665  END IF
666 #endif
667 #ifdef PARALLEL
668  IF(mesh%mycoords(1).EQ.mesh%dims(1)-1.AND.mesh%mycoords(2).EQ.0.AND.mesh%mycoords(3).EQ.0) THEN
669 #endif
670 !NEC$ SHORTLOOP
671  DO i=1,mesh%GNUM
672  pvar(mesh%IMAX+i,mesh%JMIN-i,mesh%KMIN-i,:) = (pvar(mesh%IMAX+i,mesh%JMIN,mesh%KMIN,:) &
673  + pvar(mesh%IMAX,mesh%JMIN-i,mesh%KMIN,:) + pvar(mesh%IMAX,mesh%JMIN,mesh%KMIN-i,:))/3.0
674  END DO
675 #ifdef PARALLEL
676  END IF
677 #endif
678 #ifdef PARALLEL
679  IF(mesh%mycoords(1).EQ.0.AND.mesh%mycoords(2).EQ.mesh%dims(2)-1.AND.mesh%mycoords(3).EQ.0) THEN
680 #endif
681 !NEC$ SHORTLOOP
682  DO i=1,mesh%GNUM
683  pvar(mesh%IMIN-i,mesh%JMAX+i,mesh%KMIN-i,:) = (pvar(mesh%IMIN-i,mesh%JMAX,mesh%KMIN,:) &
684  + pvar(mesh%IMIN,mesh%JMAX+i,mesh%KMIN,:) + pvar(mesh%IMIN,mesh%JMAX,mesh%KMIN-i,:))/3.0
685  END DO
686 #ifdef PARALLEL
687  END IF
688 #endif
689 #ifdef PARALLEL
690  IF(mesh%mycoords(1).EQ.mesh%dims(1)-1.AND.mesh%mycoords(2).EQ.mesh%dims(2)-1.AND.mesh%mycoords(3).EQ.0) THEN
691 #endif
692 !NEC$ SHORTLOOP
693  DO i=1,mesh%GNUM
694  pvar(mesh%IMAX+i,mesh%JMAX+i,mesh%KMIN-i,:) = (pvar(mesh%IMAX+i,mesh%JMAX,mesh%KMIN,:) &
695  + pvar(mesh%IMAX,mesh%JMAX+i,mesh%KMIN,:) + pvar(mesh%IMAX,mesh%JMAX,mesh%KMIN-i,:))/3.0
696  END DO
697 #ifdef PARALLEL
698  END IF
699 #endif
700 #ifdef PARALLEL
701  IF(mesh%mycoords(1).EQ.0.AND.mesh%mycoords(2).EQ.0.AND.mesh%mycoords(3).EQ.mesh%dims(3)-1) THEN
702 #endif
703 !NEC$ SHORTLOOP
704  DO i=1,mesh%GNUM
705  pvar(mesh%IMIN-i,mesh%JMIN-i,mesh%KMAX+i,:) = (pvar(mesh%IMIN-i,mesh%JMIN,mesh%KMAX,:) &
706  + pvar(mesh%IMIN,mesh%JMIN-i,mesh%KMAX,:) + pvar(mesh%IMIN,mesh%JMIN,mesh%KMAX+i,:))/3.0
707  END DO
708 #ifdef PARALLEL
709  END IF
710 #endif
711 #ifdef PARALLEL
712  IF(mesh%mycoords(1).EQ.mesh%dims(1)-1.AND.mesh%mycoords(2).EQ.0.AND.mesh%mycoords(3).EQ.mesh%dims(3)-1) THEN
713 #endif
714 !NEC$ SHORTLOOP
715  DO i=1,mesh%GNUM
716  pvar(mesh%IMAX+i,mesh%JMIN-i,mesh%KMAX+i,:) = (pvar(mesh%IMAX+i,mesh%JMIN,mesh%KMAX,:) &
717  + pvar(mesh%IMAX,mesh%JMIN-i,mesh%KMAX,:) + pvar(mesh%IMAX,mesh%JMIN,mesh%KMAX+i,:))/3.0
718  END DO
719 #ifdef PARALLEL
720  END IF
721 #endif
722 #ifdef PARALLEL
723  IF(mesh%mycoords(1).EQ.0.AND.mesh%mycoords(2).EQ.mesh%dims(2)-1.AND.mesh%mycoords(3).EQ.mesh%dims(3)-1) THEN
724 #endif
725 !NEC$ SHORTLOOP
726  DO i=1,mesh%GNUM
727  pvar(mesh%IMIN-i,mesh%JMAX+i,mesh%KMAX+i,:) = (pvar(mesh%IMIN-i,mesh%JMAX,mesh%KMAX,:) &
728  + pvar(mesh%IMIN,mesh%JMAX+i,mesh%KMAX,:) + pvar(mesh%IMIN,mesh%JMAX,mesh%KMAX+i,:))/3.0
729  END DO
730 #ifdef PARALLEL
731  END IF
732 #endif
733 #ifdef PARALLEL
734  IF(mesh%mycoords(1).EQ.mesh%dims(1)-1.AND.mesh%mycoords(2).EQ.mesh%dims(2)-1.AND.mesh%mycoords(3).EQ.mesh%dims(3)-1) THEN
735 #endif
736 !NEC$ SHORTLOOP
737  DO i=1,mesh%GNUM
738  pvar(mesh%IMAX+i,mesh%JMAX+i,mesh%KMAX+i,:) = (pvar(mesh%IMAX+i,mesh%JMAX,mesh%KMAX,:) &
739  + pvar(mesh%IMAX,mesh%JMAX+i,mesh%KMAX,:) + pvar(mesh%IMAX,mesh%JMAX,mesh%KMAX+i,:))/3.0
740  END DO
741 #ifdef PARALLEL
742  END IF
743 #endif
744  END IF
745 
746  END SUBROUTINE
747 
748 
749 #ifdef PARALLEL
750 
751  SUBROUTINE initboundary_mpi(this,Mesh,Physics,periods)
752 #ifdef HAVE_MPI_MOD
753  USE mpi
754 #endif
755  IMPLICIT NONE
756 #ifdef HAVE_MPIF_H
757  include 'mpif.h'
758 #endif
759  !------------------------------------------------------------------------!
760  CLASS(boundary_generic),INTENT(INOUT) :: this
761  CLASS(mesh_base), INTENT(INOUT) :: Mesh
762  CLASS(physics_base), INTENT(IN) :: Physics
763  LOGICAL, DIMENSION(3), INTENT(IN) :: periods
764  !------------------------------------------------------------------------!
765  INTEGER :: comm_old
766  INTEGER :: ierr, dir
767  LOGICAL, DIMENSION(SIZE(Mesh%dims)) :: remain_dims = .false.
768  !------------------------------------------------------------------------!
769  ! create new cartesian communicator using Mesh%comm_cart
770  ! and account for the periodicity
771  ! IMPORTANT: disable reordering of nodes
772  comm_old = mesh%comm_cart
773  CALL mpi_cart_create(comm_old,SIZE(mesh%dims),mesh%dims,periods,.false.,mesh%comm_cart,ierr)
774 
775  ! save ranks of neighbor processes
776  CALL mpi_cart_shift(mesh%comm_cart,0,1,mesh%neighbor(west),mesh%neighbor(east),ierr)
777  CALL mpi_cart_shift(mesh%comm_cart,1,1,mesh%neighbor(south),mesh%neighbor(north),ierr)
778  CALL mpi_cart_shift(mesh%comm_cart,2,1,mesh%neighbor(bottom),mesh%neighbor(top),ierr)
779 
780  ! create communicators for every column and row of the cartesian
781  ! topology (used eg. for fargo shifts)
782  remain_dims = (/ .false., .true., .true. /)
783  CALL mpi_cart_sub(mesh%comm_cart,remain_dims,mesh%Icomm,ierr)
784  remain_dims = (/ .true., .false., .true. /)
785  CALL mpi_cart_sub(mesh%comm_cart,remain_dims,mesh%Jcomm,ierr)
786  remain_dims = (/ .true., .true., .false. /)
787  CALL mpi_cart_sub(mesh%comm_cart,remain_dims,mesh%Kcomm,ierr)
788 
789  ! allocate memory for boundary data buffers
790  ALLOCATE(&
791  this%boundary(west)%p%sendbuf(mesh%GINUM,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
792  this%boundary(west)%p%recvbuf(mesh%GINUM,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
793  this%boundary(east)%p%sendbuf(mesh%GINUM,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
794  this%boundary(east)%p%recvbuf(mesh%GINUM,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
795  this%boundary(south)%p%sendbuf(mesh%IGMIN:mesh%IGMAX,mesh%GJNUM,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
796  this%boundary(south)%p%recvbuf(mesh%IGMIN:mesh%IGMAX,mesh%GJNUM,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
797  this%boundary(north)%p%sendbuf(mesh%IGMIN:mesh%IGMAX,mesh%GJNUM,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
798  this%boundary(north)%p%recvbuf(mesh%IGMIN:mesh%IGMAX,mesh%GJNUM,mesh%KGMIN:mesh%KGMAX,physics%VNUM), &
799  this%boundary(bottom)%p%sendbuf(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%GKNUM,physics%VNUM), &
800  this%boundary(bottom)%p%recvbuf(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%GKNUM,physics%VNUM), &
801  this%boundary(top)%p%sendbuf(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%GKNUM,physics%VNUM), &
802  this%boundary(top)%p%recvbuf(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%GKNUM,physics%VNUM), &
803  stat=ierr)
804  IF (ierr.NE.0) THEN
805  CALL this%boundary(west)%p%Error("boundary_generic::InitBoundary_MPI", &
806  "Unable to allocate memory for data buffers.")
807  END IF
808 
809  ! initialize all buffers with 0
810  DO dir=west,top
811  this%boundary(dir)%p%recvbuf = 0.
812  this%boundary(dir)%p%sendbuf = 0.
813  END DO
814  END SUBROUTINE initboundary_mpi
815 
817  SUBROUTINE mpiboundarycommunication(this,Mesh,Physics,pvar)
818 #ifdef HAVE_MPI_MOD
819  USE mpi
820 #endif
821  IMPLICIT NONE
822 #ifdef HAVE_MPIF_H
823  include 'mpif.h'
824 #endif
825  !------------------------------------------------------------------------!
826  CLASS(boundary_generic),INTENT(INOUT) :: this
827  CLASS(mesh_base), INTENT(IN) :: Mesh
828  CLASS(physics_base), INTENT(IN) :: Physics
829  REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX,Physics%VNUM), &
830  INTENT(INOUT) :: pvar
831  !------------------------------------------------------------------------!
832  INTEGER :: ierr
833  INTEGER :: req(4)
834 #ifdef MPI_USE_SENDRECV
835  INTEGER :: status(MPI_STATUS_SIZE)
836 #else
837  INTEGER :: status(MPI_STATUS_SIZE,4)
838 #endif
839  !------------------------------------------------------------------------!
840  ! NOTE: if you want to use MPI_Sendrecv instead of nonblocking
841  ! MPI_Irecv and MPI_Issend for exchange of ghost cell data,
842  ! you must add -DMPI_USE_SENDRECV to the compile command
843 
844  ! initiate western/eastern MPI communication
845 #ifdef MPI_USE_SENDRECV
846  ! send boundary data to western and receive from eastern neighbor
847  IF (mesh%neighbor(west).NE.mpi_proc_null) THEN
848  this%Boundary(west)%p%sendbuf(:,:,:,:) = pvar(mesh%IMIN:mesh%IMIN+mesh%GINUM-1, &
849  mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM)
850  END IF
851  CALL mpi_sendrecv(this%Boundary(west)%p%sendbuf, &
852  mesh%GINUM*(mesh%JGMAX-mesh%JGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
853  default_mpi_real,mesh%neighbor(west),10+west,this%Boundary(east)%p%recvbuf, &
854  mesh%GINUM*(mesh%JGMAX-mesh%JGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
855  default_mpi_real,mesh%neighbor(east),mpi_any_tag,mesh%comm_cart,status,ierr)
856  IF (mesh%neighbor(east).NE.mpi_proc_null) THEN
857  pvar(mesh%IMAX+1:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM) = &
858  this%Boundary(east)%p%recvbuf(:,:,:,:)
859  END IF
860 #else
861  ! receive boundary data from eastern neighbor
862  CALL mpi_irecv(this%Boundary(east)%p%recvbuf, &
863  mesh%GINUM*(mesh%JGMAX-mesh%JGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
864  default_mpi_real,mesh%neighbor(east),10+west,mesh%comm_cart,req(1),ierr)
865  ! fill send buffer if western neighbor exists
866  IF (mesh%neighbor(west).NE.mpi_proc_null) THEN
867  this%Boundary(west)%p%sendbuf(:,:,:,:) = &
868  pvar(mesh%IMIN:mesh%IMIN+mesh%GINUM-1,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM)
869  END IF
870  ! send boundary data to western neighbor
871  CALL mpi_issend(this%Boundary(west)%p%sendbuf, &
872  mesh%GINUM*(mesh%JGMAX-mesh%JGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
873  default_mpi_real,mesh%neighbor(west),10+west,mesh%comm_cart,req(2),ierr)
874 #endif
875 #ifdef MPI_USE_SENDRECV
876  ! send boundary data to eastern and receive from western neighbor
877  IF (mesh%neighbor(east).NE.mpi_proc_null) THEN
878  this%Boundary(east)%p%sendbuf(:,:,:,:) = pvar(mesh%IMAX-mesh%GINUM+1:mesh%IMAX, &
879  mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM)
880  END IF
881  CALL mpi_sendrecv(this%Boundary(east)%p%sendbuf, &
882  mesh%GINUM*(mesh%JGMAX-mesh%JGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
883  default_mpi_real,mesh%neighbor(east),10+east,this%Boundary(west)%p%recvbuf, &
884  mesh%GINUM*(mesh%JGMAX-mesh%JGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
885  default_mpi_real,mesh%neighbor(west),mpi_any_tag,mesh%comm_cart,status,ierr)
886  IF (mesh%neighbor(west).NE.mpi_proc_null) THEN
887  pvar(mesh%IGMIN:mesh%IMIN-1,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM) = &
888  this%Boundary(west)%p%recvbuf(:,:,:,:)
889  END IF
890 #else
891  ! receive boundary data from western neighbor
892  CALL mpi_irecv(this%Boundary(west)%p%recvbuf, &
893  mesh%GINUM*(mesh%JGMAX-mesh%JGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
894  default_mpi_real,mesh%neighbor(west),10+east,mesh%comm_cart,req(3),ierr)
895  ! fill send buffer if eastern neighbor exists
896  IF (mesh%neighbor(east).NE.mpi_proc_null) THEN
897  this%Boundary(east)%p%sendbuf(:,:,:,:) = &
898  pvar(mesh%IMAX-mesh%GINUM+1:mesh%IMAX,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM)
899  END IF
900  ! send boundary data to eastern neighbor
901  CALL mpi_issend(this%Boundary(east)%p%sendbuf, &
902  mesh%GINUM*(mesh%JGMAX-mesh%JGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
903  default_mpi_real,mesh%neighbor(east),10+east,mesh%comm_cart,req(4),ierr)
904 #endif
905 #ifndef MPI_USE_SENDRECV
906  ! wait for unfinished MPI communication
907  CALL mpi_waitall(4,req,status,ierr)
908  ! copy data from recieve buffers into ghosts cells
909  IF (mesh%neighbor(west).NE.mpi_proc_null) THEN
910  pvar(mesh%IGMIN:mesh%IMIN-1,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM) = &
911  this%Boundary(west)%p%recvbuf(:,:,:,:)
912  END IF
913  IF (mesh%neighbor(east).NE.mpi_proc_null) THEN
914  pvar(mesh%IMAX+1:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM) = &
915  this%Boundary(east)%p%recvbuf(:,:,:,:)
916  END IF
917 #endif
918 
919  ! initiate southern/northern MPI communication
920 #ifdef MPI_USE_SENDRECV
921  ! send boundary data to southern and receive from northern neighbor
922  IF (mesh%neighbor(south).NE.mpi_proc_null) THEN
923  this%Boundary(south)%p%sendbuf(:,:,:,:) = pvar(mesh%IGMIN:mesh%IGMAX, &
924  mesh%JMIN:mesh%JMIN+mesh%GJNUM-1,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM)
925  END IF
926  CALL mpi_sendrecv(this%Boundary(south)%p%sendbuf, &
927  mesh%GJNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
928  default_mpi_real,mesh%neighbor(south),10+south,this%Boundary(north)%p%recvbuf, &
929  mesh%GJNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
930  default_mpi_real,mesh%neighbor(north),mpi_any_tag,mesh%comm_cart,status,ierr)
931  IF (mesh%neighbor(north).NE.mpi_proc_null) THEN
932  pvar(mesh%IGMIN:mesh%IGMAX,mesh%JMAX+1:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM) = &
933  this%Boundary(north)%p%recvbuf(:,:,:,:)
934  END IF
935 #else
936  ! receive boundary data from northern neighbor
937  CALL mpi_irecv(this%Boundary(north)%p%recvbuf, &
938  mesh%GJNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
939  default_mpi_real,mesh%neighbor(north),10+south,mesh%comm_cart,req(1),ierr)
940  ! fill send buffer if southern neighbor exists
941  IF (mesh%neighbor(south).NE.mpi_proc_null) THEN
942  this%Boundary(south)%p%sendbuf(:,:,:,:) = pvar(mesh%IGMIN:mesh%IGMAX, &
943  mesh%JMIN:mesh%JMIN+mesh%GJNUM-1,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM)
944  END IF
945  ! send boundary data to southern neighbor
946  CALL mpi_issend(this%Boundary(south)%p%sendbuf, &
947  mesh%GJNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
948  default_mpi_real,mesh%neighbor(south),10+south,mesh%comm_cart,req(2),ierr)
949 #endif
950 #ifdef MPI_USE_SENDRECV
951  ! send boundary data to northern and receive from southern neighbor
952  IF (mesh%neighbor(north).NE.mpi_proc_null) THEN
953  this%Boundary(north)%p%sendbuf(:,:,:,:) = pvar(mesh%IGMIN:mesh%IGMAX, &
954  mesh%JMAX-mesh%GJNUM+1:mesh%JMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM)
955  END IF
956  CALL mpi_sendrecv(this%Boundary(north)%p%sendbuf, &
957  mesh%GJNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
958  default_mpi_real,mesh%neighbor(north),10+north,this%Boundary(south)%p%recvbuf, &
959  mesh%GJNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
960  default_mpi_real,mesh%neighbor(south),mpi_any_tag,mesh%comm_cart,status,ierr)
961  IF (mesh%neighbor(south).NE.mpi_proc_null) THEN
962  pvar(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JMIN-1,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM) = &
963  this%Boundary(south)%p%recvbuf(:,:,:,:)
964  END IF
965 #else
966  ! receive boundary data from southern neighbor
967  CALL mpi_irecv(this%Boundary(south)%p%recvbuf, &
968  mesh%GJNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
969  default_mpi_real,mesh%neighbor(south),10+north,mesh%comm_cart,req(3),ierr)
970  ! fill send buffer if northern neighbor exists
971  IF (mesh%neighbor(north).NE.mpi_proc_null) THEN
972  this%Boundary(north)%p%sendbuf(:,:,:,:) = pvar(mesh%IGMIN:mesh%IGMAX, &
973  mesh%JMAX-mesh%GJNUM+1:mesh%JMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM)
974  END IF
975  ! send boundary data to northern neighbor
976  CALL mpi_issend(this%Boundary(north)%p%sendbuf, &
977  mesh%GJNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%KGMAX-mesh%KGMIN+1)*physics%VNUM, &
978  default_mpi_real,mesh%neighbor(north),10+north,mesh%comm_cart,req(4),ierr)
979 #endif
980 #ifndef MPI_USE_SENDRECV
981  ! wait for unfinished MPI communication
982  CALL mpi_waitall(4,req,status,ierr)
983  IF (mesh%neighbor(south).NE.mpi_proc_null) THEN
984  pvar(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JMIN-1,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM) = &
985  this%Boundary(south)%p%recvbuf(:,:,:,:)
986  END IF
987  IF (mesh%neighbor(north).NE.mpi_proc_null) THEN
988  pvar(mesh%IGMIN:mesh%IGMAX,mesh%JMAX+1:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX,1:physics%VNUM) = &
989  this%Boundary(north)%p%recvbuf(:,:,:,:)
990  END IF
991 #endif
992 
993  ! initiate bottom/top MPI communication
994 #ifdef MPI_USE_SENDRECV
995  ! send boundary data to bottom and receive from top neighbor
996  IF (mesh%neighbor(bottom).NE.mpi_proc_null) THEN
997  this%Boundary(bottom)%p%sendbuf(:,:,:,:) = pvar(mesh%IGMIN:mesh%IGMAX, &
998  mesh%JGMIN:mesh%JGMAX,mesh%KMIN:mesh%KMIN+mesh%GKNUM-1,1:physics%VNUM)
999  END IF
1000  CALL mpi_sendrecv(this%Boundary(bottom)%p%sendbuf,&
1001  mesh%GKNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%JGMAX-mesh%JGMIN+1)*physics%VNUM, &
1002  default_mpi_real,mesh%neighbor(bottom),10+bottom,this%Boundary(top)%p%recvbuf, &
1003  mesh%GKNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%JGMAX-mesh%JGMIN+1)*physics%VNUM, &
1004  default_mpi_real,mesh%neighbor(top),mpi_any_tag,mesh%comm_cart,status,ierr)
1005  IF (mesh%neighbor(top).NE.mpi_proc_null) THEN
1006  pvar(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KMAX+1:mesh%KGMAX,1:physics%VNUM) = &
1007  this%Boundary(top)%p%recvbuf(:,:,:,:)
1008  END IF
1009 #else
1010  ! receive boundary data from top neighbor
1011  CALL mpi_irecv(this%Boundary(top)%p%recvbuf, &
1012  mesh%GKNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%JGMAX-mesh%JGMIN+1)*physics%VNUM, &
1013  default_mpi_real,mesh%neighbor(top),10+bottom,mesh%comm_cart,req(1),ierr)
1014  ! fill send buffer if bottomer neighbor exists
1015  IF (mesh%neighbor(bottom).NE.mpi_proc_null) THEN
1016  this%Boundary(bottom)%p%sendbuf(:,:,:,:) = pvar(mesh%IGMIN:mesh%IGMAX, &
1017  mesh%JGMIN:mesh%JGMAX,mesh%KMIN:mesh%KMIN+mesh%GKNUM-1,1:physics%VNUM)
1018  END IF
1019  ! send boundary data to bottom neighbor
1020  CALL mpi_issend(this%Boundary(bottom)%p%sendbuf, &
1021  mesh%GKNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%JGMAX-mesh%JGMIN+1)*physics%VNUM, &
1022  default_mpi_real,mesh%neighbor(bottom),10+bottom,mesh%comm_cart,req(2),ierr)
1023 #endif
1024 #ifdef MPI_USE_SENDRECV
1025  ! send boundary data to top and receive from bottom neighbor
1026  IF (mesh%neighbor(top).NE.mpi_proc_null) THEN
1027  this%Boundary(top)%p%sendbuf(:,:,:,:) = pvar(mesh%IGMIN:mesh%IGMAX, &
1028  mesh%JGMIN:mesh%JGMAX,mesh%KMAX-mesh%GKNUM+1:mesh%KMAX,1:physics%VNUM)
1029  END IF
1030  CALL mpi_sendrecv(this%Boundary(top)%p%sendbuf, &
1031  mesh%GKNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%JGMAX-mesh%JGMIN+1)*physics%VNUM, &
1032  default_mpi_real,mesh%neighbor(top),10+top,this%Boundary(bottom)%p%recvbuf, &
1033  mesh%GKNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%JGMAX-mesh%JGMIN+1)*physics%VNUM, &
1034  default_mpi_real,mesh%neighbor(bottom),mpi_any_tag,mesh%comm_cart,status,ierr)
1035  IF (mesh%neighbor(bottom).NE.mpi_proc_null) THEN
1036  pvar(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KMIN-1,1:physics%VNUM) = &
1037  this%Boundary(bottom)%p%recvbuf(:,:,:,:)
1038  END IF
1039 #else
1040  ! receive boundary data from bottom neighbor
1041  CALL mpi_irecv(this%Boundary(bottom)%p%recvbuf, &
1042  mesh%GKNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%JGMAX-mesh%JGMIN+1)*physics%VNUM, &
1043  default_mpi_real,mesh%neighbor(bottom),10+top,mesh%comm_cart,req(3),ierr)
1044  ! fill send buffer if northern neighbor exists
1045  IF (mesh%neighbor(top).NE.mpi_proc_null) THEN
1046  this%Boundary(top)%p%sendbuf(:,:,:,:) = pvar(mesh%IGMIN:mesh%IGMAX, &
1047  mesh%JGMIN:mesh%JGMAX,mesh%KMAX-mesh%GKNUM+1:mesh%KMAX,1:physics%VNUM)
1048  END IF
1049  ! send boundary data to top neighbor
1050  CALL mpi_issend(this%Boundary(top)%p%sendbuf, &
1051  mesh%GKNUM*(mesh%IGMAX-mesh%IGMIN+1)*(mesh%JGMAX-mesh%JGMIN+1)*physics%VNUM, &
1052  default_mpi_real,mesh%neighbor(top),10+top,mesh%comm_cart,req(4),ierr)
1053 #endif
1054 #ifndef MPI_USE_SENDRECV
1055  ! wait for unfinished MPI communication
1056  CALL mpi_waitall(4,req,status,ierr)
1057  IF (mesh%neighbor(bottom).NE.mpi_proc_null) THEN
1058  pvar(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KMIN-1,1:physics%VNUM) = &
1059  this%Boundary(bottom)%p%recvbuf(:,:,:,:)
1060  END IF
1061  IF (mesh%neighbor(top).NE.mpi_proc_null) THEN
1062  pvar(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KMAX+1:mesh%KGMAX,1:physics%VNUM) = &
1063  this%Boundary(top)%p%recvbuf(:,:,:,:)
1064  END IF
1065 #endif
1066 
1067  END SUBROUTINE mpiboundarycommunication
1068 #endif
1069 
1070  SUBROUTINE finalize(this)
1071  IMPLICIT NONE
1072  !------------------------------------------------------------------------!
1073  CLASS(boundary_generic), INTENT(INOUT) :: this
1074  !------------------------------------------------------------------------!
1075  INTEGER :: dir
1076  !------------------------------------------------------------------------!
1077  ! loop over all boundaries
1078  DO dir=1,6
1079 #ifdef PARALLEL
1080  ! deallocate MPI send/recv buffers
1081  DEALLOCATE(this%boundary(dir)%p%sendbuf,this%boundary(dir)%p%recvbuf)
1082 #endif
1083  END DO
1084  END SUBROUTINE finalize
1085 
1086 END MODULE boundary_generic_mod
boundary_fixed_mod::boundary_fixed
Definition: boundary_fixed.f90:46
mesh_base
logging_base_mod::finalize
subroutine finalize(this)
Destructor of common class.
Definition: logging_base.f90:155
boundary_base_mod::boundary_base
Definition: boundary_base.f90:59
boundary_custom_mod::boundary_custom
Definition: boundary_custom.f90:46
boundary_nogradients_mod::boundary_nogradients
Definition: boundary_nogradients.f90:45
logging_base_mod::default_mpi_real
integer, save default_mpi_real
default real type for MPI
Definition: logging_base.f90:80
boundary_nogradients_mod
Boundary module for reflecting boundaries.
Definition: boundary_nogradients.f90:36
common_dict::this
type(logging_base), save this
Definition: common_dict.f90:149
boundary_inner_mod::boundary_inner
Definition: boundary_inner.f90:60
marray_compound_mod
derived class for compound of mesh arrays
Definition: marray_compound.f90:35
boundary_generic_mod
Generic boundary module.
Definition: boundary_generic.f90:44
boundary_base_mod::initboundary
subroutine initboundary(this, Mesh, Physics, bctype, bcname, dir, config)
Definition: boundary_base.f90:150
logging_base_mod
Basic fosite module.
Definition: logging_base.f90:36
logging_base_mod::logging_base
common data structure
Definition: logging_base.f90:56
boundary_noslip_mod
Boundary module for noslip conditions (see wikipedia )
Definition: boundary_noslip.f90:37
boundary_generic_mod::initboundary_mpi
subroutine initboundary_mpi(this, Mesh, Physics, periods)
initializes the MPI communication
Definition: boundary_generic.f90:752
boundary_generic_mod::boundary_p
Definition: boundary_generic.f90:62
boundary_generic_mod::new_boundary
subroutine, public new_boundary(Boundary, Mesh, Physics, config, IO)
Definition: boundary_generic.f90:90
boundary_inner_mod
Boundary module for the inner boundaries (only necessary in parallel runs)
Definition: boundary_inner.f90:41
boundary_reflecting_mod
Boundary module for reflecting boundaries.
Definition: boundary_reflecting.f90:34
boundary_generic_mod::mpiboundarycommunication
subroutine mpiboundarycommunication(this, Mesh, Physics, pvar)
Handles the MPI communication of the inner (and physical periodic) boundaries.
Definition: boundary_generic.f90:818
boundary_absorbing_mod::boundary_absorbing
Definition: boundary_absorbing.f90:48
boundary_reflecting_mod::boundary_reflecting
Definition: boundary_reflecting.f90:43
boundary_shearing_mod::boundary_shearing
Definition: boundary_shearing.f90:80
boundary_absorbing_mod
Boundary module for absorbing (non-reflecting) conditions.
Definition: boundary_absorbing.f90:39
physics_base_mod::physics_base
named integer constants for flavour of state vectors
Definition: physics_base.f90:69
physics_base_mod
Basic physics module.
Definition: physics_base.f90:55
marray_compound_mod::marray_compound
data types and methods
Definition: marray_compound.f90:46
common_dict
Dictionary for generic data types.
Definition: common_dict.f90:61
boundary_generic_mod::setcorneredges
subroutine setcorneredges(this, Mesh, Physics, pvar)
Calculates the corner in 2D and the corners and edges in 3D.
Definition: boundary_generic.f90:418
boundary_base_mod::none
integer, parameter none
periodic with shear for shearing sheet/box
Definition: boundary_base.f90:108
boundary_axis_mod::boundary_axis
Definition: boundary_axis.f90:45
boundary_axis_mod
Boundary module for axis boundaries.
Definition: boundary_axis.f90:35
boundary_generic_mod::centerboundary
subroutine, private centerboundary(this, Mesh, Physics, time, pvar, cvar)
Sets boundaries in all directions.
Definition: boundary_generic.f90:279
boundary_noslip_mod::boundary_noslip
Definition: boundary_noslip.f90:47
boundary_periodic_mod
Boundary module for periodic boundary conditions.
Definition: boundary_periodic.f90:35
common_dict::dict_typ
Definition: common_dict.f90:123
boundary_periodic_mod::boundary_periodic
Definition: boundary_periodic.f90:44
boundary_shearing_mod
Boundary module for a shearingsheet/shearingbox. (see e.g. the standard run )
Definition: boundary_shearing.f90:58
boundary_custom_mod
Boundary module for custom conditions.
Definition: boundary_custom.f90:36
boundary_fixed_mod
Boundary module for fixed in/outflow conditions.
Definition: boundary_fixed.f90:37
boundary_base_mod
Definition: boundary_base.f90:40
boundary_generic_mod::boundary_generic
Definition: boundary_generic.f90:66
Generated by   doxygen 1.8.14