1*c4762a1bSJed Brown! 2*c4762a1bSJed Brown! 3*c4762a1bSJed Brown! 4*c4762a1bSJed Brown program main 5*c4762a1bSJed Brown#include <petsc/finclude/petscmat.h> 6*c4762a1bSJed Brown use petscmat 7*c4762a1bSJed Brown implicit none 8*c4762a1bSJed Brown 9*c4762a1bSJed Brown Mat A 10*c4762a1bSJed Brown PetscErrorCode ierr 11*c4762a1bSJed Brown PetscScalar, pointer :: km(:,:) 12*c4762a1bSJed Brown PetscInt three,one 13*c4762a1bSJed Brown PetscInt idxm(1),i,j 14*c4762a1bSJed Brown PetscScalar v 15*c4762a1bSJed Brown 16*c4762a1bSJed Brown call PetscInitialize(PETSC_NULL_CHARACTER,ierr) 17*c4762a1bSJed Brown if (ierr .ne. 0) then 18*c4762a1bSJed Brown print*,'Unable to initialize PETSc' 19*c4762a1bSJed Brown stop 20*c4762a1bSJed Brown endif 21*c4762a1bSJed Brown 22*c4762a1bSJed Brown call MatCreate(PETSC_COMM_WORLD,A,ierr);CHKERRA(ierr) 23*c4762a1bSJed Brown three = 3 24*c4762a1bSJed Brown call MatSetSizes(A,three,three,three,three,ierr);CHKERRA(ierr) 25*c4762a1bSJed Brown call MatSetBlockSize(A,three,ierr);CHKERRA(ierr) 26*c4762a1bSJed Brown call MatSetType(A, MATSEQBAIJ,ierr);CHKERRA(ierr) 27*c4762a1bSJed Brown call MatSetUp(A,ierr);CHKERRA(ierr) 28*c4762a1bSJed Brown 29*c4762a1bSJed Brown one = 1 30*c4762a1bSJed Brown idxm(1) = 0 31*c4762a1bSJed Brown allocate (km(three,three)) 32*c4762a1bSJed Brown do i=1,3 33*c4762a1bSJed Brown do j=1,3 34*c4762a1bSJed Brown km(i,j) = i + j 35*c4762a1bSJed Brown enddo 36*c4762a1bSJed Brown enddo 37*c4762a1bSJed Brown 38*c4762a1bSJed Brown call MatSetValuesBlocked(A, one, idxm, one, idxm, km, ADD_VALUES, ierr);CHKERRA(ierr) 39*c4762a1bSJed Brown call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr) 40*c4762a1bSJed Brown call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr) 41*c4762a1bSJed Brown call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr) 42*c4762a1bSJed Brown 43*c4762a1bSJed Brown j = 0 44*c4762a1bSJed Brown call MatGetValues(A,one,j,one,j,v,ierr);CHKERRA(ierr) 45*c4762a1bSJed Brown 46*c4762a1bSJed Brown call MatDestroy(A,ierr);CHKERRA(ierr) 47*c4762a1bSJed Brown 48*c4762a1bSJed Brown deallocate(km) 49*c4762a1bSJed Brown call PetscFinalize(ierr) 50*c4762a1bSJed Brown end 51*c4762a1bSJed Brown 52*c4762a1bSJed Brown!/*TEST 53*c4762a1bSJed Brown! 54*c4762a1bSJed Brown! test: 55*c4762a1bSJed Brown! requires: double !complex 56*c4762a1bSJed Brown! 57*c4762a1bSJed Brown!TEST*/ 58