Actual source code: ex4f.F90

      1: #include <petsc/finclude/petscmat.h>
      2: program main
      3:   use petscmat

      5:   implicit none

      7:   Mat A
      8:   PetscInt, parameter ::  n = 5, m = 5
      9:   PetscScalar, parameter ::  two = 2.0, one = 1.0
     10:   PetscInt, pointer, dimension(:) ::  dnnz, onnz
     11:   PetscInt    ::  i, rstart, rend, M1, N1
     12:   PetscErrorCode ierr

     14:   PetscCallA(PetscInitialize(ierr))

     16:   allocate (dnnz(0:m - 1), source=1_PETSC_INT_KIND)
     17:   allocate (onnz(0:m - 1), source=1_PETSC_INT_KIND)

     19:   PetscCallA(MatCreateAIJ(PETSC_COMM_WORLD, m, n, PETSC_DETERMINE, PETSC_DETERMINE, PETSC_DECIDE, dnnz, PETSC_DECIDE, onnz, A, ierr))
     20:   PetscCallA(MatSetFromOptions(A, ierr))
     21:   PetscCallA(MatSetUp(A, ierr))
     22:   deallocate (dnnz)
     23:   deallocate (onnz)

     25:   !/* This assembly shrinks memory because we do not insert enough number of values */
     26:   PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
     27:   PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))

     29:   !/* MatResetPreallocation restores the memory required by users */
     30:   PetscCallA(MatResetPreallocation(A, ierr))
     31:   PetscCallA(MatSetOption(A, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_TRUE, ierr))
     32:   PetscCallA(MatGetOwnershipRange(A, rstart, rend, ierr))
     33:   PetscCallA(MatGetSize(A, M1, N1, ierr))
     34:   do i = rstart, rend - 1
     35:     PetscCallA(MatSetValue(A, i, i, two, INSERT_VALUES, ierr))
     36:     if (rend < N1) PetscCallA(MatSetValue(A, i, rend, one, INSERT_VALUES, ierr))
     37:   end do
     38:   PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
     39:   PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))
     40:   PetscCallA(MatView(A, PETSC_VIEWER_STDOUT_WORLD, ierr))
     41:   PetscCallA(MatDestroy(A, ierr))
     42:   PetscCallA(PetscFinalize(ierr))

     44: end program

     46: !/*TEST
     47: !
     48: !   test:
     49: !      suffix: 1
     50: !      output_file: output/ex4_1.out
     51: !
     52: !   test:
     53: !      suffix: 2
     54: !      nsize: 2
     55: !      output_file: output/ex4_2.out
     56: !
     57: !TEST*/