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

  9:   Mat A
 10:   PetscErrorCode ierr
 11:   PetscScalar, pointer :: km(:, :)
 12:   PetscInt three, one
 13:   PetscInt idxm(1), i, j
 14:   PetscScalar v(1)

 16:   PetscCallA(PetscInitialize(ierr))

 18:   PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
 19:   three = 3
 20:   PetscCallA(MatSetSizes(A, three, three, three, three, ierr))
 21:   PetscCallA(MatSetBlockSize(A, three, ierr))
 22:   PetscCallA(MatSetType(A, MATSEQBAIJ, ierr))
 23:   PetscCallA(MatSetUp(A, ierr))

 25:   one = 1
 26:   idxm(1) = 0
 27:   allocate (km(three, three))
 28:   do i = 1, 3
 29:     do j = 1, 3
 30:       km(i, j) = i + j
 31:     end do
 32:   end do

 34:   PetscCallA(MatSetValuesBlocked(A, one, idxm, one, idxm, reshape(km, [three*three]), ADD_VALUES, ierr))
 35:   PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
 36:   PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))
 37:   PetscCallA(MatView(A, PETSC_VIEWER_STDOUT_WORLD, ierr))

 39:   j = 0
 40:   PetscCallA(MatGetValues(A, one, [j], one, [j], v, ierr))

 42:   PetscCallA(MatDestroy(A, ierr))

 44:   deallocate (km)
 45:   PetscCallA(PetscFinalize(ierr))
 46: end

 48: !/*TEST
 49: !
 50: !     test:
 51: !       requires: double !complex
 52: !
 53: !TEST*/