Actual source code: ex16f90.F90
petsc-3.13.4 2020-08-01
1: !
2: !
3: ! Tests MatDenseGetArray()
4: !
6: program main
7: #include <petsc/finclude/petscmat.h>
8: use petscmat
9: implicit none
11: Mat A
12: PetscErrorCode ierr
13: PetscInt i,j,m,n,iar(1),jar(1)
14: PetscInt one
15: PetscScalar v(1)
16: PetscScalar, pointer :: array(:,:)
17: PetscMPIInt rank
18: integer :: ashape(2)
19: character(len=80) :: string
21: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
22: if (ierr .ne. 0) then
23: print*,'Unable to initialize PETSc'
24: stop
25: endif
27: m = 3
28: n = 2
29: one = 1
30: !
31: ! Create a parallel dense matrix shared by all processors
32: !
33: call MatCreateDense(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,m,n,PETSC_NULL_SCALAR,A,ierr);CHKERRA(ierr)
35: !
36: ! Set values into the matrix. All processors set all values.
37: !
38: do 10, i=0,m-1
39: iar(1) = i
40: do 20, j=0,n-1
41: jar(1) = j
42: v(1) = 9.0/real(i+j+1)
43: call MatSetValues(A,one,iar,one,jar,v,INSERT_VALUES,ierr);CHKERRA(ierr)
44: 20 continue
45: 10 continue
47: call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)
48: call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)
50: !
51: ! Print the matrix to the screen
52: !
53: call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
55: !
56: ! Print the local matrix shape to the screen for each rank
57: !
58: call MatDenseGetArrayF90(A,array,ierr);CHKERRA(ierr)
59: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr);CHKERRA(ierr)
60: ashape = shape(array)
61: write(string, '("[", i0, "]", " shape (", i0, ",", i0, ")", a1)') rank, ashape(1), ashape(2), new_line('a')
62: call PetscSynchronizedPrintf(PETSC_COMM_WORLD, string, ierr);CHKERRA(ierr)
63: call PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT,ierr);CHKERRA(ierr)
64: call MatDenseRestoreArrayF90(A,array,ierr);CHKERRA(ierr)
65: !
66: ! Free the space used by the matrix
67: !
68: call MatDestroy(A,ierr);CHKERRA(ierr)
69: call PetscFinalize(ierr)
70: end
73: !/*TEST
74: !
75: ! test:
76: ! nsize: 2
77: ! filter: sort -b
78: ! filter_output: sort -b
79: !
80: !TEST*/