general_block_decomposition.f90 3.6 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
! general_block_decomposition.f90 --- build general block distribution
!
! Copyright  (C)  2010  Thomas Jahns <jahns@dkrz.de>
!
! Version: 1.0
! Keywords: ScalES PPM general block distribution
! Author: Thomas Jahns <jahns@dkrz.de>
! Maintainer: Thomas Jahns <jahns@dkrz.de>
! URL: https://www.dkrz.de/redmine/projects/show/scales-ppm
!
! Redistribution and use in source and binary forms, with or without
! modification, are  permitted provided that the following conditions are
! met:
!
! Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
!
! Neither the name of the DKRZ GmbH nor the names of its contributors
! may be used to endorse or promote products derived from this software
! without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
! IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
! PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
! OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! Commentary:
!
!
!
! Code:
!
44
MODULE general_block_decomposition
45
  USE ppm_extents, ONLY: extent, extent_start, extent_end, &
46
       extent_size, rebased_extent
47
  USE ppm_base, ONLY: assertion
48
49
50
51
52
53
54
55
  IMPLICIT NONE
  PRIVATE
  PUBLIC :: gbd_refine_2d
CONTAINS
  !> serial implementation of iterative refinement of a partitioning
  !> by alternating optimization of horizontal and vertical divisions
  !> yields a general block decomposition
  SUBROUTINE gbd_refine_2d(global_range, weights, partitions_x, partitions_y)
56
    TYPE(extent), INTENT(in) :: global_range(2)
57
58
    REAL, INTENT(in) :: weights(global_range(1)%first:, &
         global_range(2)%first:)
59
    TYPE(extent), INTENT(inout) :: partitions_x(:), &
60
         partitions_y(:)
61
62
63
64
65
66
67
68

    INTEGER :: i, j, size_x, size_y, nparts_x, nparts_y
    REAL :: part_weight(SIZE(partitions_x),SIZE(partitions_y)), max_weight

    nparts_x = SIZE(partitions_x)
    nparts_y = SIZE(partitions_y)
    size_x = SIZE(weights, 1)
    size_y = SIZE(weights, 2)
69
    CALL assertion(size_x == extent_size(global_range(1)) &
70
71
         .AND. size_y == extent_size(global_range(2)), origline=__LINE__, &
         origfile=__FILE__)
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92

    CALL compute_weights

  CONTAINS
    SUBROUTINE compute_weights
      INTEGER :: i, j
      REAL :: weight
      weight = -HUGE(weight)
      DO j = 1, nparts_y
        DO i = 1, nparts_x
          weight = SUM(weights(extent_start(partitions_x(i)): &
               extent_end(partitions_x(i)), extent_start(partitions_y(j)): &
               extent_end(partitions_y(j))))
          part_weight(i, j) = weight
          IF (weight > max_weight) max_weight = weight
        END DO
      END DO
    END SUBROUTINE compute_weights
  END SUBROUTINE gbd_refine_2d

END MODULE general_block_decomposition
93
94
95
96
97
!
! Local Variables:
! license-project-url: "https://www.dkrz.de/redmine/projects/show/scales-ppm"
! license-default: "bsd"
! End: