1: #include <petsc/finclude/petscmat.h>
  2: program main
  3:   use petscmat
  4:   implicit none

  6:   Mat A, B
  7:   PetscErrorCode ierr
  8:   PetscScalar, pointer :: km(:, :)
  9:   PetscInt, parameter :: three = 3, one = 1
 10:   PetscInt idxm(1), idxmj(1), i, j
 11:   PetscMPIInt rank, size

 13:   PetscCallA(PetscInitialize(ierr))

 15:   PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
 16:   PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD, size, ierr))

 18:   PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
 19:   PetscCallA(MatSetSizes(A, three, three, PETSC_DECIDE, PETSC_DECIDE, ierr))
 20:   PetscCallA(MatSetBlockSize(A, three, ierr))
 21:   PetscCallA(MatSetUp(A, ierr))
 22:   PetscCallA(MatDuplicate(A, MAT_DO_NOT_COPY_VALUES, B, ierr))
 23:   idxm(1) = 0
 24:   allocate (km(three, three))
 25:   do i = 1, 3
 26:     do j = 1, 3
 27:       km(1, 1) = i + j
 28:       idxm(1) = i - 1 + 3*rank
 29:       idxmj(1) = j - 1 + 3*rank
 30:       PetscCallA(MatSetValues(B, one, idxm, one, idxmj, reshape(km, [three**2]), ADD_VALUES, ierr))
 31:     end do
 32:   end do

 34:   PetscCallA(MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr))
 35:   PetscCallA(MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY, ierr))
 36:   PetscCallA(MatView(B, PETSC_VIEWER_STDOUT_WORLD, ierr))

 38:   PetscCallA(MatDestroy(A, ierr))
 39:   PetscCallA(MatDestroy(B, ierr))

 41:   deallocate (km)
 42:   PetscCallA(PetscFinalize(ierr))
 43: end

 45: !/*TEST
 46: !
 47: !   test:
 48: !     nsize: 2
 49: !
 50: !TEST*/