Actual source code: ex17f.F90

      1: program main
      2: #include <petsc/finclude/petscvec.h>
      3: #include <petsc/finclude/petscmat.h>

      5:   use petscvec
      6:   use petscmat

      8:   implicit none

     10:   Mat A
     11:   MatPartitioning part
     12:   IS is
     13:   PetscInt   ::     i, m, N
     14:   PetscInt   ::     rstart, rend
     15:   PetscInt, pointer, dimension(:) ::   emptyranks, bigranks, cols
     16:   PetscScalar, pointer, dimension(:) :: vals
     17:   PetscInt :: &
     18:     nbigranks = 10, &
     19:     nemptyranks = 10
     20:   PetscMPIInt   ::  rank, sizef
     21:   PetscErrorCode ierr
     22:   PetscBool set
     23:   PetscInt, parameter :: zero = 0, one = 1, two = 2, three = 3

     25:   PetscCallA(PetscInitialize(ierr))

     27:   PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
     28:   PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD, sizef, ierr))

     30:   allocate (emptyranks(nemptyranks))
     31:   allocate (bigranks(nbigranks))

     33:   PetscCallA(PetscOptionsGetIntArray(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-emptyranks', emptyranks, nemptyranks, set, ierr))
     34:   PetscCallA(PetscOptionsGetIntArray(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-bigranks', bigranks, nbigranks, set, ierr))

     36:   m = 1
     37:   do i = 1, nemptyranks
     38:     if (rank == emptyranks(i)) m = 0
     39:   end do
     40:   do i = 1, nbigranks
     41:     if (rank == bigranks(i)) m = 5
     42:   end do

     44:   deallocate (emptyranks)
     45:   deallocate (bigranks)

     47:   PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
     48:   PetscCallA(MatSetsizes(A, m, m, PETSC_DECIDE, PETSC_DECIDE, ierr))
     49:   PetscCallA(MatSetFromOptions(A, ierr))
     50:   PetscCallA(MatSeqAIJSetPreallocation(A, three, PETSC_NULL_INTEGER_ARRAY, ierr))
     51:   PetscCallA(MatMPIAIJSetPreallocation(A, three, PETSC_NULL_INTEGER_ARRAY, two, PETSC_NULL_INTEGER_ARRAY, ierr))
     52:   PetscCallA(MatSeqBAIJSetPreallocation(A, one, three, PETSC_NULL_INTEGER_ARRAY, ierr))
     53:   PetscCallA(MatMPIBAIJSetPreallocation(A, one, three, PETSC_NULL_INTEGER_ARRAY, two, PETSC_NULL_INTEGER_ARRAY, ierr))
     54:   PetscCallA(MatSeqSBAIJSetPreallocation(A, one, two, PETSC_NULL_INTEGER_ARRAY, ierr))
     55:   PetscCallA(MatMPISBAIJSetPreallocation(A, one, two, PETSC_NULL_INTEGER_ARRAY, one, PETSC_NULL_INTEGER_ARRAY, ierr))

     57:   PetscCallA(MatGetSize(A, PETSC_NULL_INTEGER, N, ierr))
     58:   PetscCallA(MatGetOwnershipRange(A, rstart, rend, ierr))

     60:   allocate (cols(1:3))
     61:   allocate (vals(1:3))
     62:   do i = rstart, rend - 1

     64:     cols = (/mod((i + N - 1), N), i, mod((i + 1), N)/)
     65:     vals = [1.0, 1.0, 1.0]
     66:     PetscCallA(MatSetValues(A, one, [i], three, cols, vals, INSERT_VALUES, ierr))
     67:   end do
     68:   deallocate (cols)
     69:   deallocate (vals)
     70:   PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
     71:   PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))
     72:   PetscCallA(MatView(A, PETSC_VIEWER_STDOUT_WORLD, ierr))

     74:   PetscCallA(MatPartitioningCreate(PETSC_COMM_WORLD, part, ierr))
     75:   PetscCallA(MatPartitioningSetAdjacency(part, A, ierr))
     76:   PetscCallA(MatPartitioningSetFromOptions(part, ierr))
     77:   PetscCallA(MatPartitioningApply(part, is, ierr))
     78:   PetscCallA(ISView(is, PETSC_VIEWER_STDOUT_WORLD, ierr))
     79:   PetscCallA(ISDestroy(is, ierr))
     80:   PetscCallA(MatPartitioningDestroy(part, ierr))
     81:   PetscCallA(MatDestroy(A, ierr))
     82:   PetscCallA(PetscFinalize(ierr))

     84: end program

     86: !/*TEST
     87: !
     88: !   test:
     89: !      nsize: 8
     90: !      args: -emptyranks 0,2,4 -bigranks 1,3,7 -mat_partitioning_type average
     91: !      output_file: output/ex17_1.out
     92: !      # cannot test with external package partitioners since they produce different results on different systems
     93: !
     94: !TEST*/