xref: /petsc/src/mat/tutorials/ex4f.F90 (revision 6a98f8dc3f2c9149905a87dc2e9d0fedaf64e09a)
1program main
2#include <petsc/finclude/petscvec.h>
3#include <petsc/finclude/petscmat.h>
4
5use petscvec
6use petscmat
7
8implicit none
9
10  Mat             A
11  PetscInt,parameter ::  n=5,m=5
12  PetscScalar,parameter ::  two =2.0, one = 1.0
13  PetscInt,pointer,dimension(:) ::  dnnz,onnz
14  PetscInt    ::  i,rstart,rend,M1,N1
15  PetscErrorCode  ierr
16
17  call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
18
19  if (ierr /= 0) then
20   print*,'PetscInitialize failed'
21   stop
22  endif
23
24
25  allocate(dnnz(0:m-1))
26  allocate(onnz(0:m-1))
27
28  do i=0,m-1
29   dnnz(i) = 1
30   onnz(i) = 1
31  end do
32
33  call MatCreateAIJ(PETSC_COMM_WORLD,m,n,PETSC_DETERMINE,PETSC_DETERMINE,PETSC_DECIDE,dnnz,PETSC_DECIDE,onnz,A,ierr);CHKERRA(ierr)
34  call MatSetFromOptions(A,ierr);CHKERRA(ierr)
35  call MatSetUp(A,ierr);CHKERRA(ierr)
36  deallocate(dnnz)
37  deallocate(onnz)
38
39  !/* This assembly shrinks memory because we do not insert enough number of values */
40  call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)
41  call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)
42
43  !/* MatResetPreallocation restores the memory required by users */
44  call MatResetPreallocation(A,ierr);CHKERRA(ierr)
45  call MatSetOption(A,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE,ierr);CHKERRA(ierr)
46  call MatGetOwnershipRange(A,rstart,rend,ierr);CHKERRA(ierr)
47  call MatGetSize(A,M1,N1,ierr);CHKERRA(ierr)
48  do i=rstart,rend-1
49   call MatSetValue(A,i,i,two,INSERT_VALUES,ierr);CHKERRA(ierr)
50   if (rend<N1) call MatSetValue(A,i,rend,one,INSERT_VALUES,ierr);CHKERRA(ierr)
51  end do
52  call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)
53  call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)
54  call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
55  call MatDestroy(A,ierr);CHKERRA(ierr)
56  call PetscFinalize(ierr);CHKERRA(ierr)
57
58end program
59
60!/*TEST
61!
62!   test:
63!      suffix: 1
64!      output_file: output/ex4_1.out
65!
66!   test:
67!      suffix: 2
68!      nsize: 2
69!      output_file: output/ex4_2.out
70!
71!TEST*/
72