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