Actual source code: ex16f90.F90

petsc-3.12.2 2019-11-22
Report Typos and Errors
  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*/