1! 2! 3! 4program main 5#include <petsc/finclude/petscmat.h> 6 use petscmat 7 implicit none 8 9 Mat A 10 PetscErrorCode ierr 11 PetscScalar, pointer :: km(:, :) 12 PetscInt three, one 13 PetscInt idxm(1), i, j 14 PetscScalar v(1) 15 16 PetscCallA(PetscInitialize(ierr)) 17 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)) 24 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 33 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)) 38 39 j = 0 40 PetscCallA(MatGetValues(A, one, [j], one, [j], v, ierr)) 41 42 PetscCallA(MatDestroy(A, ierr)) 43 44 deallocate (km) 45 PetscCallA(PetscFinalize(ierr)) 46end 47 48!/*TEST 49! 50! test: 51! requires: double !complex 52! 53!TEST*/ 54