Octopus
mesh_partition.F90
Go to the documentation of this file.
1!! Copyright (C) 2002-2013 M. Marques, A. Castro, A. Rubio, G. Bertsch, M. Oliveira
2!! Copyright (C) 2021 S. Ohlmann
3!!
4!! This program is free software; you can redistribute it and/or modify
5!! it under the terms of the GNU General Public License as published by
6!! the Free Software Foundation; either version 2, or (at your option)
7!! any later version.
8!!
9!! This program is distributed in the hope that it will be useful,
10!! but WITHOUT ANY WARRANTY; without even the implied warranty of
11!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12!! GNU General Public License for more details.
13!!
14!! You should have received a copy of the GNU General Public License
15!! along with this program; if not, write to the Free Software
16!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
17!! 02110-1301, USA.
18!!
19
20#include "global.h"
21
23 use debug_oct_m
24 use global_oct_m
25 use index_oct_m
26 use io_oct_m
27 use mesh_oct_m
28 use metis_oct_m
30 use mpi_oct_m
32 use parser_oct_m
36 use space_oct_m
39
40 implicit none
41
42 private
43 public :: &
50
51 integer, parameter :: &
52 METIS = 1, &
53 parmetis = 2, &
54 hilbert = 3
55
56 integer, parameter :: &
57 RCB = 1, &
58 graph = 2
59
60contains
61
62 ! ---------------------------------------------------------------
72 ! ---------------------------------------------------------------
73 subroutine mesh_partition(mesh, namespace, space, lapl_stencil, vsize)
74 type(mesh_t), intent(inout) :: mesh
75 type(namespace_t), intent(in) :: namespace
76 class(space_t), intent(in) :: space
77 type(stencil_t), intent(in) :: lapl_stencil
78 integer, intent(in) :: vsize
81
82 integer :: jp, jpart
83 integer(imetis) :: iv
84 integer(int64) :: ivtmp, inb
85 integer :: ix(space%dim), jx(space%dim)
86
87 integer :: npart
88 integer :: ipart
89
90 integer(imetis) :: ne_global
91 integer(imetis) :: nv_global
98 integer(imetis) :: ne
99 integer :: nv
100
101 integer(imetis), allocatable :: xadj_global(:)
102 integer(imetis), allocatable :: adjncy_global(:)
103 integer(imetis), allocatable :: adjncy(:)
104 integer(imetis), allocatable :: xadj(:)
105
106 integer(imetis), allocatable :: options(:)
107#ifdef HAVE_METIS
108 integer(imetis) :: edgecut
109#endif
110 real(real32), allocatable :: tpwgts(:)
111
112 integer :: iunit
113 integer, allocatable :: rcounts(:)
114 integer(imetis) :: tmp
115 integer(imetis), allocatable :: rdispls(:)
116 integer(imetis), allocatable :: part(:)
117 integer(imetis), allocatable :: part_global(:)
118 integer(imetis), allocatable :: vtxdist(:)
119
120 type(stencil_t) :: stencil
121 integer :: stencil_to_use, default_method, method
122 integer :: library
123 integer, parameter :: STAR = 1, laplacian = 2
124 integer(imetis), allocatable :: istart(:)
125 integer, allocatable :: lsize(:)
126
127 integer :: default, ierr
128
129 push_sub_with_profile(mesh_partition)
130
131 if (mesh%np_global == 0) then
132 message(1) = 'The mesh is empty and cannot be partitioned.'
133 call messages_fatal(1, namespace=namespace)
134 end if
135
136 !%Variable MeshPartitionPackage
137 !%Type integer
138 !%Section Execution::Parallelization
139 !%Description
140 !% Decides which library to use to perform the mesh partition.
141 !% By default ParMETIS is used when available, otherwise METIS is used.
142 !%Option metis 1
143 !% METIS library.
144 !%Option parmetis 2
145 !% (Experimental) Use ParMETIS library to perform the mesh partition.
146 !% Only available if the code was compiled with ParMETIS support.
147 !%Option part_hilbert 3
148 !% Use the ordering along the Hilbert curve for partitioning.
149 !%End
150 default = metis
151#ifdef HAVE_PARMETIS
152 default = parmetis
153#endif
154 call parse_variable(namespace, 'MeshPartitionPackage', default, library)
155
156#if !defined(HAVE_METIS)
157 if (library == metis) then
158 message(1) = 'METIS was requested, but Octopus was compiled without it.'
159 call messages_fatal(1, only_root_writes = .true.)
160 end if
161#endif
162#if !defined(HAVE_PARMETIS)
163 if (library == parmetis) then
164 message(1) = 'PARMETIS was requested, but Octopus was compiled without it.'
165 call messages_fatal(1, only_root_writes = .true.)
166 end if
167#endif
168
169 !%Variable MeshPartitionStencil
170 !%Type integer
171 !%Default stencil_star
172 !%Section Execution::Parallelization
173 !%Description
174 !% To partition the mesh, it is necessary to calculate the connection
175 !% graph connecting the points. This variable selects which stencil
176 !% is used to do this.
177 !%Option stencil_star 1
178 !% An order-one star stencil.
179 !%Option laplacian 2
180 !% The stencil used for the Laplacian is used to calculate the
181 !% partition. This in principle should give a better partition, but
182 !% it is slower and requires more memory.
183 !%End
184 call parse_variable(namespace, 'MeshPartitionStencil', star, stencil_to_use)
185
186 if (stencil_to_use == star) then
187 call stencil_star_get_lapl(stencil, mesh%box%dim, order = 1)
188 else if (stencil_to_use == laplacian) then
189 call stencil_copy(lapl_stencil, stencil)
190 else
191 call messages_input_error(namespace, 'MeshPartitionStencil')
192 end if
193
194 ! Shortcut to the global number of vertices
195 if (mesh%np_global > huge(nv_global)) then
196 message(1) = "Error: too many grid points for this version of metis/parmetis."
197 message(2) = "Please use the 64-bit version."
198 call messages_fatal(2, namespace=namespace)
199 end if
200 nv_global = i8_to_imetis(mesh%np_global)
201
202 call partition_init(mesh%partition, imetis_to_i8(nv_global), mesh%mpi_grp)
203
204 ! Get number of partitions.
205 npart = mesh%mpi_grp%size
206 ipart = mesh%mpi_grp%rank + 1
207
208 safe_allocate(istart(1:npart))
209 safe_allocate(lsize(1:npart))
210 safe_allocate(vtxdist(1:npart+1))
211 call partition_get_local_size(mesh%partition, ivtmp, nv)
212 assert(ivtmp <= huge(0_imetis))
213 iv = i8_to_imetis(ivtmp)
214
215 ! Allocate local output matrix
216 safe_allocate(part(1:nv))
217 if (library == hilbert) then
218 part = ipart
219 else
220
221 call mesh%mpi_grp%allgather(iv, 1, mpi_metis_int, istart(1), 1, mpi_metis_int)
222 call mesh%mpi_grp%allgather(nv, 1, mpi_integer, lsize(1), 1, mpi_integer)
223
224 vtxdist(1:npart) = istart(1:npart)
225 vtxdist(npart+1) = nv_global + 1
226
227 ! Create graph with each point being represented by a
228 ! vertex and edges between neighbouring points.
229 safe_allocate(xadj(1:nv+1))
230 safe_allocate(adjncy(1:i4_to_imetis(stencil%size - 1)*nv))
231 ne = 1
232 ! Iterate over number of vertices.
233 do iv = 1, lsize(ipart)
234 ! Get coordinates of point iv (vertex iv).
235 call mesh_global_index_to_coords(mesh, imetis_to_i8(istart(ipart)-1 + iv), ix)
236
237 ! Set entry in index table.
238 xadj(iv) = ne
239 ! Check all possible neighbours.
240 do jp = 1, stencil%size
241 if (jp == stencil%center) cycle
242
243 ! Store coordinates of possible neighbors, they
244 ! are needed several times in the check below.
245 jx = ix + stencil%points(:, jp)
246
247 if (all(jx >= mesh%idx%nr(1, :)) .and. all(jx <= mesh%idx%nr(2, :))) then
248 ! Only points inside the mesh or its enlargement
249 ! are included in the graph.
250 inb = mesh_global_index_from_coords(mesh, jx)
251 if (inb /= 0 .and. inb <= nv_global) then
252 ! Store a new edge and increment edge counter.
253 adjncy(ne) = i8_to_imetis(inb)
254 ne = ne + 1
255 end if
256 end if
257 end do
258 end do
259 ! We started with ne=1 for simplicity, so ne is off by one in the end.
260 ne = ne - 1
261
262 ! Set the total number of edges plus one as last index.
263 ! (NOTE: the plus one is because we are using Fortran numbering)
264 ! The reason is: neighbours of node i are stored in adjncy(xadj(i):xadj(i+1)-1).
265 ! Setting the last index as mentioned makes special handling of last element
266 ! unnecessary (this indexing is a METIS requirement).
267 xadj(nv+1) = ne + 1
268
269
270 if (debug%info .or. library == metis) then
271 !Gather the global xadj and adjncy arrays
272 safe_allocate(rcounts(1:npart))
273 safe_allocate(rdispls(1:npart))
274
275 safe_allocate(xadj_global(1:nv_global + 1))
276 xadj_global(1) = 1
277 rcounts(1:npart) = lsize(1:npart)
278 rdispls(1:npart) = vtxdist(1:npart) - 1
279 call mesh%mpi_grp%allgatherv(xadj(2:), lsize(ipart), mpi_metis_int, &
280 xadj_global(2:), rcounts, rdispls, mpi_metis_int)
281 do jpart = 2, npart
282 do iv = 1, lsize(jpart)
283 xadj_global(istart(jpart) + iv) = xadj_global(istart(jpart) + iv) + xadj_global(istart(jpart)) - 1
284 end do
285 end do
286
287 ne_global = xadj_global(nv_global + 1)
288 safe_allocate(adjncy_global(1:ne_global))
289 do jpart = 1, npart
290 rdispls(jpart) = xadj_global(vtxdist(jpart)) - 1
291 tmp = xadj_global(vtxdist(jpart+1)) - 1 - rdispls(jpart)
292 assert(tmp < huge(0_int32))
293 rcounts(jpart) = imetis_to_i4(tmp)
294 end do
295 assert(xadj(nv+1)-1 < huge(0_int32))
296 call mesh%mpi_grp%allgatherv(adjncy, imetis_to_i4(xadj(nv+1)-1), mpi_metis_int, &
297 adjncy_global, rcounts, rdispls, mpi_metis_int)
298
299 safe_deallocate_a(rcounts)
300 safe_deallocate_a(rdispls)
301 end if
302
303
304 if (debug%info) then
305 ! DEBUG output. Write graph to file mesh_graph.txt.
306 message(1) = 'Info: Adjacency lists of the graph representing the grid'
307 message(2) = 'Info: are stored in debug/mesh_partition/mesh_graph.txt.'
308 message(3) = 'Info: Compatible with METIS programs pmetis and kmetis.'
309 message(4) = 'Info: First line contains number of vertices and edges.'
310 message(5) = 'Info: Edges are not directed and appear twice in the lists.'
311 call messages_info(5)
312 if (mpi_grp_is_root(mpi_world)) then
313 call io_mkdir('debug/mesh_partition', namespace)
314 iunit = io_open('debug/mesh_partition/mesh_graph.txt', namespace, action='write')
315 write(iunit, *) nv_global, ne_global/2
316 do iv = 1, nv
317 write(iunit, *) adjncy_global(xadj_global(iv):xadj_global(iv+1) - 1)
318 end do
319 call io_close(iunit)
320 end if
321 message(1) = "Info: Done writing mesh_graph.txt."
322 call messages_info(1, namespace=namespace)
323 end if
324
325 ! The sum of all tpwgts elements has to be 1 and
326 ! we don`t care about the weights. So; 1/npart
327 safe_allocate(tpwgts(1:vsize))
328 tpwgts(1:vsize) = real(1.0, real32)/real(vsize, real32)
329
330 select case (library)
331 case (metis)
332 safe_allocate(options(1:40))
333 options = 0
334#ifdef HAVE_METIS
335 call oct_metis_setdefaultoptions(options(1)) ! is equal to: options = -1
336#endif
337 options(metis_option_numbering) = 1 ! Fortran style: start counting from 1
338
339 if (vsize < 8) then
340 default_method = rcb
341 else
342 default_method = graph
343 end if
344
345 !%Variable MeshPartition
346 !%Type integer
347 !%Section Execution::Parallelization
348 !%Description
349 !% When using METIS to perform the mesh partitioning, decides which
350 !% algorithm is used. By default, <tt>graph</tt> partitioning
351 !% is used for 8 or more partitions, and <tt>rcb</tt> for fewer.
352 !%Option rcb 1
353 !% Recursive coordinate bisection partitioning.
354 !%Option graph 2
355 !% Graph partitioning (called 'k-way' by METIS).
356 !%End
357 call parse_variable(namespace, 'MeshPartition', default_method, method)
358
359 safe_allocate(part_global(1:nv_global))
360
361 !Now we can call METIS
362 select case (method)
363 case (rcb)
364 message(1) = 'Info: Using METIS 5 multilevel recursive bisection to partition the mesh.'
365 call messages_info(1, namespace=namespace)
366#ifdef HAVE_METIS
367 ierr = oct_metis_partgraphrecursive(nv_global, 1_imetis, xadj_global(1), adjncy_global(1), &
368 i4_to_imetis(vsize), tpwgts(1), 1.01_4, options(1), edgecut, part_global(1))
369#endif
370 call metis_error_code(ierr)
371 case (graph)
372 message(1) = 'Info: Using METIS 5 multilevel k-way algorithm to partition the mesh.'
373 call messages_info(1, namespace=namespace)
374#ifdef HAVE_METIS
375 ierr = oct_metis_partgraphkway(nv_global, 1_imetis, xadj_global(1), adjncy_global(1), &
376 i4_to_imetis(vsize), tpwgts(1), 1.01_4, options(1), edgecut, part_global(1))
377#endif
378 call metis_error_code(ierr)
379 case default
380 message(1) = 'Selected partition method is not available in METIS 5.'
381 call messages_fatal(1, namespace=namespace)
382 end select
383
384 part(1:nv) = part_global(istart(ipart):istart(ipart) + nv - 1)
385
386 safe_deallocate_a(options)
387 safe_deallocate_a(part_global)
388
389 case (parmetis)
390
391 safe_allocate(options(1:3))
392 options = 0 ! For the moment we use default options
393
394 write(message(1),'(a)') 'Info: Using ParMETIS multilevel k-way algorithm to partition the mesh.'
395 call messages_info(1, namespace=namespace)
396
397 ! Call to ParMETIS with no imbalance tolerance
398#ifdef HAVE_PARMETIS
399 call oct_parmetis_v3_partkway(vtxdist(1), xadj(1), adjncy(1), &
400 1_imetis, i4_to_imetis(mesh%mpi_grp%size), tpwgts(1), 1.05_4, &
401 options(1), edgecut, part(1), mesh%mpi_grp%comm%MPI_VAL)
402#endif
403
404 ! Deallocate matrices
405 safe_deallocate_a(options)
406
407 end select
408
409 safe_deallocate_a(vtxdist)
410
411 if (debug%info .or. library == metis) then
412 safe_deallocate_a(xadj_global)
413 safe_deallocate_a(adjncy_global)
414 end if
415 safe_deallocate_a(tpwgts)
416 safe_deallocate_a(xadj)
417 safe_deallocate_a(adjncy)
418 safe_deallocate_a(istart)
419 safe_deallocate_a(lsize)
420 end if
421
422 assert(all(part(1:nv) > 0))
423 assert(all(part(1:nv) <= vsize))
424 call partition_set(mesh%partition, imetis_to_i4(part))
425
426 safe_deallocate_a(part)
427
428 call stencil_end(stencil)
429 pop_sub_with_profile(mesh_partition)
430
431 contains
432
433 subroutine metis_error_code(ierr)
434 integer, intent(in) :: ierr
435
437
438 select case (ierr)
439 case (metis_ok)
440 !Everything OK
441 case (metis_error_input)
442 message(1) = "Metis: Input error."
443 call messages_fatal(1, namespace=namespace)
444 case (metis_error_memory)
445 message(1) = "Metis: Unable to allocate required memory."
446 call messages_fatal(1, namespace=namespace)
447 case (metis_error)
448 message(1) = "Metis: Some type of error."
449 call messages_fatal(1, namespace=namespace)
450 end select
451
453 end subroutine metis_error_code
454
455 end subroutine mesh_partition
456
457 ! ----------------------------------------------------
460 subroutine mesh_partition_from_parent(mesh, parent)
461 type(mesh_t), intent(inout) :: mesh
462 type(mesh_t), intent(in) :: parent
463
464 integer :: np, ip_local
465 integer(int64) :: istart, ip_global
466 integer(int64), allocatable :: points(:)
467 integer, allocatable :: part(:)
468 integer :: idx(1:3)
469
471
472 !Initialize partition
473 call partition_init(mesh%partition, mesh%np_global, mesh%mpi_grp)
474 call partition_get_local_size(mesh%partition, istart, np)
475
476 !Get the partition number of each point from the parent mesh
477 safe_allocate(points(1:np))
478 safe_allocate(part(1:np))
479 do ip_local = 1, np
480 ip_global = istart + ip_local - 1
481 call mesh_global_index_to_coords(mesh, ip_global, idx)
482 points(ip_local) = mesh_global_index_from_coords(parent, 2*idx)
483 end do
484 call partition_get_partition_number(parent%partition, np, points, part)
485
486 !Set the partition
487 call partition_set(mesh%partition, part)
488
489 !Free memory
490 safe_deallocate_a(points)
491 safe_deallocate_a(part)
492
494 end subroutine mesh_partition_from_parent
495
496 ! ----------------------------------------------------
497 subroutine mesh_partition_dump(restart, mesh, vsize, ierr)
498 type(restart_t), intent(in) :: restart
499 type(mesh_t), intent(in) :: mesh
500 integer, intent(in) :: vsize
501 integer, intent(out) :: ierr
502
503 integer :: err
504 character(len=6) :: numstring
505
506 push_sub_with_profile(mesh_partition_dump)
507
508 ierr = 0
509
510 if (restart_skip(restart)) then
511 pop_sub_with_profile(mesh_partition_dump)
512 return
513 end if
514
515 if (debug%info) then
516 message(1) = "Debug: Writing mesh partition restart."
517 call messages_info(1)
518 end if
519
520 write(numstring, '(i6.6)') vsize
521
522 call partition_dump(mesh%partition, restart_dir(restart), 'inner_partition_'//trim(numstring)//'.obf', err)
523 if (err /= 0) then
524 message(1) = "Unable to write inner mesh partition to 'inner_partition_"//trim(numstring)//".obf'"
525 call messages_warning(1)
526 ierr = ierr + 1
527 end if
528
529 if (debug%info) then
530 message(1) = "Debug: Writing mesh partition restart done."
531 call messages_info(1)
532 end if
533
534 pop_sub_with_profile(mesh_partition_dump)
535 end subroutine mesh_partition_dump
536
537 ! ----------------------------------------------------
538 subroutine mesh_partition_load(restart, mesh, ierr)
539 type(restart_t), intent(in) :: restart
540 type(mesh_t), intent(inout) :: mesh
541 integer, intent(out) :: ierr
542
543 integer :: err
544 character(len=6) :: numstring
545 character(len=MAX_PATH_LEN) :: filename, dir
546
547 push_sub(mesh_partition_load)
548
549 ierr = 0
550
551 if (restart_skip(restart)) then
552 ierr = -1
553 pop_sub(mesh_partition_load)
554 return
555 end if
556
557 if (debug%info) then
558 message(1) = "Debug: Reading mesh partition restart."
559 call messages_info(1)
560 end if
561
562 call partition_init(mesh%partition, mesh%np_global, mesh%mpi_grp)
563
564 write(numstring, '(i6.6)') mesh%mpi_grp%size
565 dir = restart_dir(restart)
566
567 !Read inner partition
568 filename = 'inner_partition_'//numstring//'.obf'
569 if (.not. io_file_exists(trim(dir)//"/"//filename)) then
570 message(1) = "Unable to read inner mesh partition, file '"//trim(filename)//"' does not exist."
571 call messages_warning(1)
572 ierr = ierr + 1
573 else
574 call partition_load(mesh%partition, restart_dir(restart), filename, err)
575 if (err /= 0) then
576 message(1) = "Unable to read inner mesh partition from '"//trim(filename)//"'."
578 ierr = ierr + 2
579 end if
580 end if
581
582 ! Free the memory in case we were unable to read the partitions
583 if (ierr /= 0) then
584 call partition_end(mesh%partition)
585 end if
586
587 if (debug%info) then
588 message(1) = "Debug: Reading mesh partition restart done."
589 call messages_info(1)
590 end if
591
592 pop_sub(mesh_partition_load)
593 end subroutine mesh_partition_load
594
595
596 ! ----------------------------------------------------------------------
597 subroutine mesh_partition_write_info(mesh, iunit, namespace)
598 type(mesh_t), intent(in) :: mesh
599 integer, optional, intent(in) :: iunit
600 type(namespace_t), optional, intent(in) :: namespace
601
602 integer(int64) :: npoints
603 integer :: npart
604 integer, allocatable :: nghost(:), nbound(:), nlocal(:), nneigh(:)
605 integer :: num_ghost, num_bound, num_local, num_neigh
606 real(real64) :: quality
607
608 integer :: ipart
609 logical, allocatable :: is_a_neigh(:)
610 real(real64) :: scal
611
612 push_sub_with_profile(mesh_partition_write_info)
613
614 ! Build information about the mesh partition
615 npart = mesh%mpi_grp%size
616 npoints = mesh%np_part_global
617
618 safe_allocate(nghost(1:npart))
619 safe_allocate(nbound(1:npart))
620 safe_allocate(nlocal(1:npart))
621 safe_allocate(nneigh(1:npart))
622 safe_allocate(is_a_neigh(1:npart))
623
624 ipart = mesh%mpi_grp%rank + 1
625
626 num_local = mesh%np
627 num_ghost = mesh%pv%np_ghost
628 num_bound = mesh%pv%np_bndry
629
630 is_a_neigh = mesh%pv%ghost_rcounts > 0
631 num_neigh = count(is_a_neigh(1:npart))
632
633 safe_deallocate_a(is_a_neigh)
634
635 call mesh%mpi_grp%gather(num_neigh, 1, mpi_integer, nneigh(1), 1, mpi_integer, 0)
636 call mesh%mpi_grp%gather(num_local, 1, mpi_integer, nlocal(1), 1, mpi_integer, 0)
637 call mesh%mpi_grp%gather(num_ghost, 1, mpi_integer, nghost(1), 1, mpi_integer, 0)
638 call mesh%mpi_grp%gather(num_bound, 1, mpi_integer, nbound(1), 1, mpi_integer, 0)
639
640 ! Calculate partition quality
641 scal = real(npart, real64) /npoints
642
643 quality = m_zero
644
645 quality = quality + (real(maxval(nlocal), real64) - real(minval(nlocal), real64))**3
646 quality = quality + (sum(real(nghost, real64) **2))
647
648 quality = m_one/(m_one + quality)
649
650
651 ! Only the root has the information (nlocal, nghost, ...)
652 if (mpi_grp_is_root(mesh%mpi_grp)) then
653 ! Write information about the partition
654 message(1) = &
655 'Info: Mesh partition:'
656 message(2) = ''
657 call messages_info(2, iunit=iunit, namespace=namespace)
658
659 write(message(1),'(a,e16.6)') &
660 ' Partition quality:', quality
661 message(2) = ''
662 call messages_info(2, iunit=iunit, namespace=namespace)
663
664 write(message(1),'(a)') &
665 ' Neighbours Ghost points'
666 write(message(2),'(a,i5,a,i10)') &
667 ' Average : ', nint(sum(real(nneigh, real64) )/npart), ' ', nint(sum(real(nghost, real64) )/npart)
668 write(message(3),'(a,i5,a,i10)') &
669 ' Minimum : ', minval(nneigh), ' ', minval(nghost)
670 write(message(4),'(a,i5,a,i10)') &
671 ' Maximum : ', maxval(nneigh), ' ', maxval(nghost)
672 message(5) = ''
673 call messages_info(5, iunit=iunit, namespace=namespace)
674
675 do ipart = 1, npart
676 write(message(1),'(a,i5)') &
677 ' Nodes in domain-group ', ipart
678 write(message(2),'(a,i10,a,i10)') &
679 ' Neighbours :', nneigh(ipart), &
680 ' Local points :', nlocal(ipart)
681 write(message(3),'(a,i10,a,i10)') &
682 ' Ghost points :', nghost(ipart), &
683 ' Boundary points :', nbound(ipart)
684 call messages_info(3, iunit=iunit, namespace=namespace)
685 end do
686
687 message(1) = ''
688 call messages_info(1, iunit=iunit, namespace=namespace)
689 end if
690
691 safe_deallocate_a(nghost)
692 safe_deallocate_a(nbound)
693 safe_deallocate_a(nlocal)
694 safe_deallocate_a(nneigh)
695
696 pop_sub_with_profile(mesh_partition_write_info)
697 end subroutine mesh_partition_write_info
698
699 ! ----------------------------------------------------
700 subroutine mesh_partition_messages_debug(mesh, namespace)
701 type(mesh_t), intent(in) :: mesh
702 type(namespace_t), intent(in) :: namespace
703
704 integer :: ip
705 integer(int64) :: ipg
706 integer :: iunit ! For debug output to files.
707 character(len=6) :: filenum
708
709 if (.not. debug%info) return
710
712
713 call io_mkdir('debug/mesh_partition', namespace)
714
715 ! Debug output. Write points of each partition in a different file.
716 write(filenum, '(i6.6)') mesh%mpi_grp%rank+1
717
718 ! without boundary
719 iunit = io_open('debug/mesh_partition/mesh_partition.'//filenum, &
720 namespace, action='write')
721 do ip = 1, mesh%np
722 ipg = mesh_local2global(mesh, ip)
723 write(iunit, '(i8,99f18.8)') ipg, mesh_x_global(mesh, ipg)
724 end do
725 call io_close(iunit)
726
727 ! with boundary included
728 iunit = io_open('debug/mesh_partition/mesh_partition_all.'//filenum, &
729 namespace, action='write')
730 do ip = 1, mesh%np_part
731 ipg = mesh_local2global(mesh, ip)
732 write(iunit, '(i8,99f18.8)') ipg, mesh_x_global(mesh, ipg)
733 end do
734 call io_close(iunit)
735
736 ! points from enlargement
737 if (mpi_grp_is_root(mpi_world)) then
738 iunit = io_open('debug/mesh_partition/mesh_partition_boundary', &
739 namespace, action='write')
740 do ipg = mesh%np_global+1, mesh%np_part_global
741 write(iunit, '(i8,99f18.8)') ipg, mesh_x_global(mesh, ipg)
742 end do
743 call io_close(iunit)
744 end if
745
747
748 end subroutine mesh_partition_messages_debug
749
750end module mesh_partition_oct_m
751
752!! Local Variables:
753!! mode: f90
754!! coding: utf-8
755!! End:
subroutine metis_error_code(ierr)
type(debug_t), save, public debug
Definition: debug.F90:154
real(real64), parameter, public m_zero
Definition: global.F90:187
real(real64), parameter, public m_one
Definition: global.F90:188
This module implements the index, used for the mesh points.
Definition: index.F90:122
Definition: io.F90:114
subroutine, public io_close(iunit, grp)
Definition: io.F90:468
logical function, public io_file_exists(filename, msg)
Returns true if a file with name 'filename' exists and issues a reminder.
Definition: io.F90:598
subroutine, public io_mkdir(fname, namespace, parents)
Definition: io.F90:354
integer function, public io_open(file, namespace, action, status, form, position, die, recl, grp)
Definition: io.F90:395
This module defines the meshes, which are used in Octopus.
Definition: mesh.F90:118
subroutine, public mesh_global_index_to_coords(mesh, ipg, ix)
Given a global point index, this function returns the set of integer coordinates of the point.
Definition: mesh.F90:925
integer(int64) function, public mesh_global_index_from_coords(mesh, ix)
This function returns the true global index of the point for a given vector of integer coordinates.
Definition: mesh.F90:916
integer(int64) function, public mesh_local2global(mesh, ip)
This function returns the global mesh index for a given local index.
Definition: mesh.F90:959
real(real64) function, dimension(1:mesh%box%dim), public mesh_x_global(mesh, ipg)
Definition: mesh.F90:804
integer, parameter hilbert
subroutine, public mesh_partition_from_parent(mesh, parent)
create a mesh partition from a given parent mesh
subroutine, public mesh_partition_write_info(mesh, iunit, namespace)
integer, parameter graph
subroutine, public mesh_partition_messages_debug(mesh, namespace)
integer, parameter parmetis
subroutine, public mesh_partition(mesh, namespace, space, lapl_stencil, vsize)
This routine converts the mesh given by grid points into a graph.
subroutine, public mesh_partition_dump(restart, mesh, vsize, ierr)
subroutine, public mesh_partition_load(restart, mesh, ierr)
subroutine, public messages_warning(no_lines, all_nodes, namespace)
Definition: messages.F90:543
subroutine, public messages_info(no_lines, iunit, verbose_limit, stress, all_nodes, namespace)
Definition: messages.F90:624
character(len=256), dimension(max_lines), public message
to be output by fatal, warning
Definition: messages.F90:160
subroutine, public messages_fatal(no_lines, only_root_writes, namespace)
Definition: messages.F90:420
subroutine, public messages_input_error(namespace, var, details, row, column)
Definition: messages.F90:723
This module contains interfaces for METIS and PARMETIS routines.
Definition: metis.F90:118
integer, parameter metis_ok
Returned normally.
Definition: metis.F90:154
integer, parameter metis_option_numbering
Definition: metis.F90:126
integer, parameter metis_error_memory
Returned due to insufficient memory.
Definition: metis.F90:154
integer, parameter metis_error_input
Returned due to erroneous inputs and/or options.
Definition: metis.F90:154
type(mpi_datatype), parameter mpi_metis_int
Definition: metis.F90:166
integer, parameter metis_error
Some other errors.
Definition: metis.F90:154
logical function mpi_grp_is_root(grp)
Is the current MPI process of grpcomm, root.
Definition: mpi.F90:430
type(mpi_grp_t), public mpi_world
Definition: mpi.F90:266
subroutine, public partition_init(partition, np_global, mpi_grp)
initialize the partition table
Definition: partition.F90:194
subroutine, public partition_set(partition, part)
Definition: partition.F90:242
subroutine, public partition_dump(partition, dir, filename, ierr)
write the partition data
Definition: partition.F90:259
subroutine, public partition_end(partition)
Definition: partition.F90:231
subroutine, public partition_load(partition, dir, filename, ierr)
read the partition data
Definition: partition.F90:304
subroutine, public partition_get_local_size(partition, istart, np_local)
Definition: partition.F90:380
character(len=max_path_len) function, public restart_dir(restart)
Returns the name of the directory containing the restart information. The use of this function should...
Definition: restart.F90:755
logical pure function, public restart_skip(restart)
Returns true if the restart information should neither be read nor written. This might happen because...
Definition: restart.F90:967
This module defines stencils used in Octopus.
Definition: stencil.F90:135
subroutine, public stencil_end(this)
Definition: stencil.F90:214
subroutine, public stencil_copy(input, output)
Definition: stencil.F90:196
This module defines routines, generating operators for a star stencil.
subroutine, public stencil_star_get_lapl(this, dim, order)
Describes mesh distribution to nodes.
Definition: mesh.F90:186
int true(void)