1program main 2#include <petsc/finclude/petscvec.h> 3#include <petsc/finclude/petscmat.h> 4 5 use petscvec 6 use petscmat 7 8 implicit none 9 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 24 25 PetscCallA(PetscInitialize(ierr)) 26 27 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr)) 28 PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD, sizef, ierr)) 29 30 allocate (emptyranks(nemptyranks)) 31 allocate (bigranks(nbigranks)) 32 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)) 35 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 43 44 deallocate (emptyranks) 45 deallocate (bigranks) 46 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)) 56 57 PetscCallA(MatGetSize(A, PETSC_NULL_INTEGER, N, ierr)) 58 PetscCallA(MatGetOwnershipRange(A, rstart, rend, ierr)) 59 60 allocate (cols(1:3)) 61 allocate (vals(1:3)) 62 do i = rstart, rend - 1 63 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)) 73 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)) 83 84end program 85 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*/ 95