39 logical:: cart_created=.false.
41 logical:: mpi_periodic(3)
43 integer:: mpi_cord3(3)
44 integer:: mpi_plane(3)
48 integer:: mpi_comm_cart
64 procedure:: coords_to_rank
65 procedure:: rank_to_coords
74 FUNCTION rank_to_coords (self, rank)
result (coords)
76 integer:: rank, coords(3)
79 if (self%size == 1)
then 82 call mpi_cart_coords (self%cart_comm, rank, 3, coords, mpi_err)
83 call mpi%assert (
'MPI_CART_COORDS', mpi_err)
88 END FUNCTION rank_to_coords
93 FUNCTION coords_to_rank (self, coords)
result (rank)
95 integer:: coords(3), rank
101 call mpi_cart_rank (self%cart_comm, coords, rank, mpi_err)
103 call mpi%assert (
'MPI_CART_RANK', mpi_err)
107 END FUNCTION coords_to_rank
112 SUBROUTINE init (self, mpi_dims, dims)
114 integer,
optional:: mpi_dims(3), dims(3)
116 subroutine mpi_create_mpi (mpi_dims, dims)
117 integer,
dimension(3),
optional:: mpi_dims, dims
122 call cart_create_mpi (self, mpi_dims, dims=dims)
123 self%coords = mpi_cord3
125 self%plane = mpi_plane
130 mpi_coords%cart_comm = self%cart_comm
131 mpi_coords%coords = self%coords
132 mpi_coords%dims = self%dims
133 mpi_coords%plane = self%plane
134 mpi_coords%beam = self%beam
135 mpi_coords%dn = self%dn
136 mpi_coords%up = self%up
137 mpi_coords%ok = self%ok
138 if (mpi%size /= product(mpi_dim3))
then 139 print*,
'inconsistent mpi%size:', mpi%size, mpi_dim3
146 SUBROUTINE print (self)
151 call self%mpi_t%print
152 do rank=0,self%size-1
153 if (rank==self%rank)
then 154 print *,
'...............................................' 155 print *,
'mpi%rank =', self%rank
156 print *,
'mpi%dims =', self%dims
157 print *,
'mpi%coords =', self%coords
158 print *,
'mpi%beam =', self%beam
159 print *,
'mpi%plane =', self%plane
160 print *,
'mpi%dn =', self%dn
161 print *,
'mpi%up =', self%up
163 call mpi%barrier (delay=0.25)
165 else if (self%master)
then 166 print *,
"WARNING: no MPI cartesian coordinates" 177 SUBROUTINE cart_create_mpi (self, mpi_dims, dims)
180 integer,
dimension(3),
optional:: mpi_dims, dims
181 integer:: i, m, color, size, n(3)
183 character(len=120),
save:: id= &
184 'mpi_coords.f90 $Id: 5537d0e6a4f17e3fbcc8d04daec765c27fdfb16d $' 185 integer,
save:: itimer=0
191 mpi_periodic = .true.
196 if (
present(mpi_dims))
then 198 if (
present(dims))
then 201 ok = product(mpi_dims)==self%size
203 if (self%rank==0) print
'(a,i7,2x,3i5)',
' mpi%size, mpi_dims =', self%size, mpi_dims
205 if (
present(dims))
then 206 if (product(dims)/self%size*self%size == product(dims))
then 208 m = self%size**0.333334
209 if (m**3 == self%size)
then 210 mpi_dim3 = [m,m,m];
if (test_is_ok())
exit 212 m = self%size**0.500001
213 if (m**2 == self%size)
then 214 mpi_dim3 = [m,m, 1];
if (test_is_ok())
exit 215 mpi_dim3 = [m, 1,m];
if (test_is_ok())
exit 216 mpi_dim3 = [ 1,m,m];
if (test_is_ok())
exit 219 mpi_dim3 = [m,1,1];
if (test_is_ok())
exit 220 mpi_dim3 = [1,m,1];
if (test_is_ok())
exit 221 mpi_dim3 = [1,1,m];
if (test_is_ok())
exit 222 call fail (
'WARNING: none of the simple choices worked')
225 call fail (
'WARNING: mpi%size must be a divisor in =', product(dims))
228 call fail (
'WARNING: either mpi_dims(3) or dims(3) must be present')
231 if (self%size /= product(mpi_dim3))
then 232 call fail (
'WARNING: mpi%size must be equal to product(mpi_dims) =', &
237 call mpi_cart_create (mpi_comm_world, 3, mpi_dim3, mpi_periodic, mpi_reorder, &
238 mpi_comm_cart, mpi_err)
240 self%cart_comm = mpi_comm_cart
241 if (self%rank==0) print
'(13x,a,3i5)',
' Using mpi_dims =', mpi_dim3
242 call mpi%assert (
'cart_creat_mpi: cart', mpi_err)
247 call mpi_cart_coords (mpi_comm_cart, self%rank, 3, mpi_cord3, mpi_err)
249 call mpi%assert (
'cart_creat_mpi: mpi_cord3', mpi_err)
255 call mpi_cart_shift (mpi_comm_cart, i-1, 1, mpi_dn(i), mpi_up(i), mpi_err)
257 call mpi%assert (
'cart_creat_mpi: mpi_dn/up', mpi_err)
262 call mpi_comm_split (mpi_comm_world, mpi_cord3(i), self%rank, mpi_plane(i),&
265 call mpi%assert (
'cart_creat_mpi: mpi_plane', mpi_err)
269 color = merge(0,mpi_cord3(1),i==1) &
270 + merge(0,mpi_cord3(2),i==2)*mpi_dim3(1) &
271 + merge(0,mpi_cord3(3),i==3)*mpi_dim3(1)*mpi_dim3(2)
273 call mpi_comm_split (mpi_comm_world, color, mpi_cord3(i), mpi_beam(i), mpi_err)
275 call mpi%assert (
'cart_creat_mpi: mpi_beam', mpi_err)
277 cart_created = .true.
279 logical function test_is_ok ()
281 test_is_ok = all(n*mpi_dim3 == dims) .and. product(mpi_dim3)==self%size
283 if (self%rank==0) print
'(13x,a,3i5,l5)',
'trying mpi_dims =', mpi_dim3, ok
285 subroutine fail (label, i)
286 character(len=*):: label
287 integer,
optional:: i
288 if (self%rank==0)
then 296 END SUBROUTINE cart_create_mpi
300 SUBROUTINE finalize (self)
307 call mpi_comm_free(mpi_comm_cart,mpi_err)
309 call mpi_comm_free(mpi_plane(i),mpi_err)
310 call mpi%assert (
'finalize_cart: mpi_plane',mpi_err)
311 call mpi_comm_free(mpi_beam(i),mpi_err)
312 call mpi%assert (
'finalize_cart: mpi_beam',mpi_err)
316 END SUBROUTINE finalize
Each thread uses a private timer data type, with arrays for start time and total time for each regist...