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 15 16 call PetscInitialize(PETSC_NULL_CHARACTER,ierr) 17 if (ierr .ne. 0) then 18 print*,'Unable to initialize PETSc' 19 stop 20 endif 21 22 call MatCreate(PETSC_COMM_WORLD,A,ierr);CHKERRA(ierr) 23 three = 3 24 call MatSetSizes(A,three,three,three,three,ierr);CHKERRA(ierr) 25 call MatSetBlockSize(A,three,ierr);CHKERRA(ierr) 26 call MatSetType(A, MATSEQBAIJ,ierr);CHKERRA(ierr) 27 call MatSetUp(A,ierr);CHKERRA(ierr) 28 29 one = 1 30 idxm(1) = 0 31 allocate (km(three,three)) 32 do i=1,3 33 do j=1,3 34 km(i,j) = i + j 35 enddo 36 enddo 37 38 call MatSetValuesBlocked(A, one, idxm, one, idxm, km, ADD_VALUES, ierr);CHKERRA(ierr) 39 call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr) 40 call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr) 41 call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr) 42 43 j = 0 44 call MatGetValues(A,one,j,one,j,v,ierr);CHKERRA(ierr) 45 46 call MatDestroy(A,ierr);CHKERRA(ierr) 47 48 deallocate(km) 49 call PetscFinalize(ierr) 50 end 51 52!/*TEST 53! 54! test: 55! requires: double !complex 56! 57!TEST*/ 58