Actual source code: ex209f.F90

petsc-3.13.4 2020-08-01
Report Typos and Errors
  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

 16:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 17:       if (ierr .ne. 0) then
 18:         print*,'Unable to initialize PETSc'
 19:         stop
 20:       endif

 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)

 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

 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)

 43:       j = 0
 44:       call MatGetValues(A,one,j,one,j,v,ierr);CHKERRA(ierr)

 46:       call MatDestroy(A,ierr);CHKERRA(ierr)

 48:       deallocate(km)
 49:       call PetscFinalize(ierr)
 50:       end

 52: !/*TEST
 53: !
 54: !     test:
 55: !       requires: double !complex
 56: !
 57: !TEST*/