Actual source code: ex209f.F90

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

  9:       Mat      A
 10:       PetscErrorCode ierr
 11:       PetscScalar, pointer :: km(:,:)
 12:       PetscInt three,one
 13:       PetscInt idxm(1),i,j
 14:       PetscScalar v(1)

 16:       PetscCallA(PetscInitialize(ierr))

 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))

 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

 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))

 39:       j = 0
 40:       PetscCallA(MatGetValues(A,one,[j],one,[j],v,ierr))

 42:       PetscCallA(MatDestroy(A,ierr))

 44:       deallocate(km)
 45:       PetscCallA(PetscFinalize(ierr))
 46:       end

 48: !/*TEST
 49: !
 50: !     test:
 51: !       requires: double !complex
 52: !
 53: !TEST*/