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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
#include "cctk.h"
subroutine splitregions_recursively ( &
cxx_superregs, nsuperregs, &
cxx_regs, &
nprocs, &
ghostsize_, alpha_, limit_size_, granularity_, granularity_boundary_, &
procid_)
use carpet_boxtypes
implicit none
integer, intent(in) :: nsuperregs
CCTK_POINTER, intent(in) :: cxx_superregs
CCTK_POINTER, intent(in) :: cxx_regs
integer, intent(in) :: nprocs
integer, intent(in) :: ghostsize_
CCTK_REAL, intent(in) :: alpha_
integer, intent(in) :: limit_size_
CCTK_INT, intent(in) :: granularity_
CCTK_INT, intent(in) :: granularity_boundary_
integer, intent(in) :: procid_
type(ptr), allocatable :: sregions(:)
type(boundary) :: outbound
CCTK_POINTER :: cxx_superreg
CCTK_POINTER :: cxx_tree
type(bbox) :: box
integer :: i
! Callback functions that are implemented in C++
interface
subroutine carpet_get_region (cxx_superregs, i, cxx_superreg)
use carpet_boxtypes
implicit none
CCTK_POINTER, intent(in) :: cxx_superregs
integer, intent(in) :: i
CCTK_POINTER, intent(out) :: cxx_superreg
end subroutine carpet_get_region
subroutine carpet_get_bbox (cxx_superreg, box)
use carpet_boxtypes
implicit none
CCTK_POINTER, intent(in) :: cxx_superreg
type(bbox), intent(out) :: box
end subroutine carpet_get_bbox
subroutine carpet_insert_region (cxx_regs, reg)
use carpet_boxtypes
implicit none
CCTK_POINTER, intent(in) :: cxx_regs
type(superregion2slim), intent(in) :: reg
end subroutine carpet_insert_region
subroutine carpet_create_tree_branch &
(nch, dir, bounds, cxx_subtrees, cxx_tree)
use carpet_boxtypes
implicit none
integer, intent(in) :: nch
integer, intent(in) :: dir
integer, intent(in) :: bounds(nch+1)
CCTK_POINTER, intent(in) :: cxx_subtrees(nch)
CCTK_POINTER, intent(in) :: cxx_tree
end subroutine carpet_create_tree_branch
subroutine carpet_create_tree_leaf (sreg, cxx_tree)
use carpet_boxtypes
implicit none
type(superregion2slim), intent(in) :: sreg
CCTK_POINTER, intent(out) :: cxx_tree
end subroutine carpet_create_tree_leaf
end interface
! Set global parameters
ghostsize = ghostsize_
alpha = alpha_
limit_size = limit_size_ /= 0
granularity = granularity_
granularity_boundary = granularity_boundary_
procid = procid_
outbound%obound(:,:) = 1
allocate (sregions(nsuperregs))
do i=1, nsuperregs
call carpet_get_region (cxx_superregs, i-1, cxx_superreg)
call carpet_get_bbox (cxx_superreg, box)
call create_sregion (box, outbound, i-1, sregions(i)%point)
end do
call SplitSuperRegions (sregions, nprocs)
do i=1, nsuperregs
call carpet_get_region (cxx_superregs, i-1, cxx_superreg)
call insert_region (sregions(i)%point, cxx_tree, cxx_regs)
call carpet_set_tree (cxx_superreg, cxx_tree)
end do
do i=1, nsuperregs
call destroy_sregion (sregions(i)%point)
end do
deallocate (sregions)
contains
recursive subroutine insert_region (sreg, cxx_tree, cxx_regs)
! The intent has been removed to make it compile with gfortran 4.1.
! type(superregion2), pointer, intent(in) :: sreg
type(superregion2), pointer :: sreg
CCTK_POINTER, intent(in) :: cxx_regs
CCTK_POINTER, intent(out) :: cxx_tree
integer :: nch, ich
integer :: dir
integer, allocatable :: bounds(:)
CCTK_POINTER, allocatable :: cxx_subtrees(:)
type(superregion2slim) :: sregslim
! TODO: insert tree dependencies into superregs
if (associated(sreg%children)) then
! The region has children: traverse them recursively
nch = size(sreg%children)
allocate (bounds(nch+1))
allocate (cxx_subtrees(nch))
if (nch /= 2) then
call CCTK_WARN (CCTK_WARN_ABORT, "number of children is not 2")
end if
do dir=1, 3
if (sreg%children(1)%point%extent%dim(dir)%upper + &
sreg%children(2)%point%extent%dim(dir)%stride == &
sreg%children(2)%point%extent%dim(dir)%lower) then
goto 100
end if
if (sreg%children(1)%point%extent%dim(dir)%lower /= &
sreg%children(2)%point%extent%dim(dir)%lower .or. &
sreg%children(1)%point%extent%dim(dir)%upper /= &
sreg%children(2)%point%extent%dim(dir)%upper) then
call CCTK_WARN (CCTK_WARN_ABORT, "children differ in unexpected ways")
end if
end do
call CCTK_WARN (CCTK_WARN_ABORT, "could not determine direction")
100 continue
bounds(1) = sreg%children(1)%point%extent%dim(dir)%lower
bounds(2) = sreg%children(2)%point%extent%dim(dir)%lower
bounds(3) = sreg%children(2)%point%extent%dim(dir)%upper + &
sreg%children(2)%point%extent%dim(dir)%stride
do ich=1, nch
call insert_region &
(sreg%children(ich)%point, cxx_subtrees(ich), cxx_regs)
end do
call carpet_create_tree_branch &
(nch, dir-1, bounds, cxx_subtrees, cxx_tree)
else
! The region is a leaf: insert it
sregslim%extent = sreg%extent
sregslim%outer_boundaries = sreg%outer_boundaries
sregslim%map = sreg%map
sregslim%processor = sreg%processor
call carpet_create_tree_leaf (sregslim, cxx_tree)
call carpet_insert_region (cxx_regs, sregslim)
end if
end subroutine insert_region
end subroutine splitregions_recursively
|
