Actual source code: ex209f.F90

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

  6:   Mat A
  7:   PetscErrorCode ierr
  8:   PetscScalar, pointer :: km(:, :)
  9:   PetscInt i, j
 10:   PetscScalar v(1)

 12:   PetscCallA(PetscInitialize(ierr))

 14:   PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
 15:   PetscCallA(MatSetSizes(A, 3_PETSC_INT_KIND, 3_PETSC_INT_KIND, 3_PETSC_INT_KIND, 3_PETSC_INT_KIND, ierr))
 16:   PetscCallA(MatSetBlockSize(A, 3_PETSC_INT_KIND, ierr))
 17:   PetscCallA(MatSetType(A, MATSEQBAIJ, ierr))
 18:   PetscCallA(MatSetUp(A, ierr))

 20:   allocate (km(3_PETSC_INT_KIND, 3_PETSC_INT_KIND))
 21:   do i = 1, 3
 22:     do j = 1, 3
 23:       km(i, j) = i + j
 24:     end do
 25:   end do

 27:   PetscCallA(MatSetValuesBlocked(A, 1_PETSC_INT_KIND, [0_PETSC_INT_KIND], 1_PETSC_INT_KIND, [0_PETSC_INT_KIND], reshape(km, [3_PETSC_INT_KIND**2]), ADD_VALUES, ierr))
 28:   PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
 29:   PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))
 30:   PetscCallA(MatView(A, PETSC_VIEWER_STDOUT_WORLD, ierr))

 32:   PetscCallA(MatGetValues(A, 1_PETSC_INT_KIND, [0_PETSC_INT_KIND], 1_PETSC_INT_KIND, [0_PETSC_INT_KIND], v, ierr))

 34:   PetscCallA(MatDestroy(A, ierr))

 36:   deallocate (km)
 37:   PetscCallA(PetscFinalize(ierr))
 38: end

 40: !/*TEST
 41: !
 42: !     test:
 43: !       requires: double !complex
 44: !
 45: !TEST*/