1! 2! 3! 4 program 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 enddo 32 enddo 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)) 46 end 47 48!/*TEST 49! 50! test: 51! requires: double !complex 52! 53!TEST*/ 54