1: program main

  3: #include <petsc/finclude/petscvec.h>
  4: #include <petsc/finclude/petscmat.h>

  6:   use petscvec
  7:   use petscmat

  9:   implicit none

 11:   Mat             :: A
 12:   MatPartitioning :: part
 13:   IS              :: is
 14:   PetscInt        :: r,myStart,myEnd
 15:   PetscInt        :: N = 10
 16:   PetscErrorCode  :: ierr
 17:   PetscScalar,pointer,dimension(:) :: vals
 18:   PetscInt,pointer,dimension(:) :: cols
 19:   PetscBool :: flg
 20:   PetscInt,parameter :: one = 1, two = 2, three = 3

 22:   call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 23:   if (ierr /= 0) then
 24:    print*,'PetscInitialize failed'
 25:    stop
 26:   endif

 28:   call PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-N",N,flg,ierr);CHKERRA(ierr)
 29:   call MatCreate(PETSC_COMM_WORLD, A,ierr);CHKERRA(ierr)
 30:   call MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, N, N,ierr);CHKERRA(ierr)
 31:   call MatSetFromOptions(A,ierr);CHKERRA(ierr)
 32:   call MatSeqAIJSetPreallocation(A, three, PETSC_NULL_INTEGER,ierr);CHKERRA(ierr)
 33:   call MatMPIAIJSetPreallocation(A, three, PETSC_NULL_INTEGER, two, PETSC_NULL_INTEGER,ierr);CHKERRA(ierr)

 35:   !/* Create a linear mesh */
 36:   call MatGetOwnershipRange(A, myStart, myEnd,ierr);CHKERRA(ierr)

 38:   do r=myStart,myEnd-1
 39:     if (r == 0) then
 40:      allocate(vals(2))
 41:      vals = 1.0
 42:      allocate(cols(2),source=[r,r+1])
 43:      call MatSetValues(A, one, r, two, cols, vals, INSERT_VALUES,ierr);CHKERRA(ierr)
 44:      deallocate(cols)
 45:      deallocate(vals)
 46:     else if (r == N-1) then
 47:      allocate(vals(2))
 48:      vals = 1.0
 49:      allocate(cols(2),source=[r-1,r])
 50:      call MatSetValues(A, one, r, two, cols, vals, INSERT_VALUES,ierr);CHKERRA(ierr)
 51:      deallocate(cols)
 52:      deallocate(vals)
 53:     else
 54:      allocate(vals(3))
 55:      vals = 1.0
 56:      allocate(cols(3),source=[r-1,r,r+1])
 57:      call MatSetValues(A, one, r, three, cols, vals, INSERT_VALUES,ierr);CHKERRA(ierr)
 58:      deallocate(cols)
 59:      deallocate(vals)
 60:     end if
 61:   end do
 62:   call MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)
 63:   call MatAssemblyend(A, MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)
 64:   call MatPartitioningCreate(PETSC_COMM_WORLD, part,ierr);CHKERRA(ierr)
 65:   call MatPartitioningSetAdjacency(part, A,ierr);CHKERRA(ierr)
 66:   call MatPartitioningSetFromOptions(part,ierr);CHKERRA(ierr)
 67:   call MatPartitioningApply(part, is,ierr);CHKERRA(ierr)
 68:   call ISView(is, PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
 69:   call ISDestroy(is,ierr);CHKERRA(ierr)
 70:   call MatPartitioningDestroy(part,ierr);CHKERRA(ierr)
 71:   call MatDestroy(A,ierr);CHKERRA(ierr)
 72:   call PetscFinalize(ierr);CHKERRA(ierr)

 74: end program

 76: !/*TEST
 77: !
 78: !   test:
 79: !      nsize: 3
 80: !      requires: parmetis
 81: !      args: -mat_partitioning_type parmetis
 82: !      output_file: output/ex15_1.out
 83: !
 84: !   test:
 85: !      suffix: 2
 86: !      nsize: 3
 87: !      requires: ptscotch
 88: !      args: -mat_partitioning_type ptscotch
 89: !      output_file: output/ex15_2.out
 90: !
 91: !   test:
 92: !      suffix: 3
 93: !      nsize: 4
 94: !      requires: party
 95: !      args: -mat_partitioning_type party
 96: !      output_file: output/ex15_3.out
 97: !
 98: !   test:
 99: !      suffix: 4
100: !      nsize: 3
101: !      requires: chaco
102: !      args: -mat_partitioning_type chaco
103: !      output_file: output/ex15_4.out
104: !
105: !   test:
106: !      suffix: 5
107: !      nsize: 3
108: !      requires: parmetis
109: !      args: -mat_partitioning_type hierarch -mat_partitioning_hierarchical_nfineparts 3 -mat_partitioning_nparts 10 -N 100
110: !      output_file: output/ex15_5.out
111: !
112: !TEST*/