Actual source code: ex209f.F90
petsc-3.13.4 2020-08-01
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*/