xref: /petsc/src/mat/tests/ex241f.F90 (revision c4762a1b19cd2af06abeed90e8f9d34fb975dd94)
1*c4762a1bSJed Brown!     Test code contributed by Thibaut Appel <t.appel17@imperial.ac.uk>
2*c4762a1bSJed Brown
3*c4762a1bSJed Brown  program test_assembly
4*c4762a1bSJed Brown
5*c4762a1bSJed Brown#include <petsc/finclude/petscmat.h>
6*c4762a1bSJed Brown
7*c4762a1bSJed Brown  use PetscMat
8*c4762a1bSJed Brown  use ISO_Fortran_Env, only : output_unit, real64
9*c4762a1bSJed Brown
10*c4762a1bSJed Brown  implicit none
11*c4762a1bSJed Brown  PetscInt,    parameter :: wp = real64, n = 10
12*c4762a1bSJed Brown  PetscScalar, parameter :: zero = 0.0, one = 1.0
13*c4762a1bSJed Brown  Mat      :: L
14*c4762a1bSJed Brown  PetscInt :: istart, iend, row, i1, i0
15*c4762a1bSJed Brown  PetscErrorCode :: ierr
16*c4762a1bSJed Brown
17*c4762a1bSJed Brown  PetscInt    cols(1),rows(1)
18*c4762a1bSJed Brown  PetscScalar  vals(1)
19*c4762a1bSJed Brown
20*c4762a1bSJed Brown  call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
21*c4762a1bSJed Brown  if (ierr .ne. 0) then
22*c4762a1bSJed Brown    print*,'Unable to initialize PETSc'
23*c4762a1bSJed Brown    stop
24*c4762a1bSJed Brown  endif
25*c4762a1bSJed Brown
26*c4762a1bSJed Brown  i0 = 0
27*c4762a1bSJed Brown  i1 = 1
28*c4762a1bSJed Brown
29*c4762a1bSJed Brown  call MatCreate(PETSC_COMM_WORLD,L,ierr); CHKERRA(ierr)
30*c4762a1bSJed Brown  call MatSetType(L,MATAIJ,ierr); CHKERRA(ierr)
31*c4762a1bSJed Brown  call MatSetSizes(L,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr); CHKERRA(ierr)
32*c4762a1bSJed Brown
33*c4762a1bSJed Brown  call MatSeqAIJSetPreallocation(L,i1,PETSC_NULL_INTEGER,ierr); CHKERRA(ierr)
34*c4762a1bSJed Brown  call MatMPIAIJSetPreallocation(L,i1,PETSC_NULL_INTEGER,i0,PETSC_NULL_INTEGER,ierr); CHKERRA(ierr) ! No allocated non-zero in off-diagonal part
35*c4762a1bSJed Brown  call MatSetOption(L,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE,ierr); CHKERRA(ierr)
36*c4762a1bSJed Brown  call MatSetOption(L,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE,ierr); CHKERRA(ierr)
37*c4762a1bSJed Brown  call MatSetOption(L,MAT_NO_OFF_PROC_ENTRIES,PETSC_TRUE,ierr); CHKERRA(ierr)
38*c4762a1bSJed Brown
39*c4762a1bSJed Brown  call MatGetOwnershipRange(L,istart,iend,ierr); CHKERRA(ierr)
40*c4762a1bSJed Brown
41*c4762a1bSJed Brown  ! assembling a diagonal matrix
42*c4762a1bSJed Brown  do row = istart,iend-1
43*c4762a1bSJed Brown
44*c4762a1bSJed Brown    cols = [row]; vals = [one]; rows = [row];
45*c4762a1bSJed Brown    call MatSetValues(L,i1,rows,i1,cols,vals,ADD_VALUES,ierr); CHKERRA(ierr)
46*c4762a1bSJed Brown
47*c4762a1bSJed Brown  end do
48*c4762a1bSJed Brown
49*c4762a1bSJed Brown  call MatAssemblyBegin(L,MAT_FINAL_ASSEMBLY,ierr); CHKERRA(ierr)
50*c4762a1bSJed Brown  call MatAssemblyEnd(L,MAT_FINAL_ASSEMBLY,ierr); CHKERRA(ierr)
51*c4762a1bSJed Brown
52*c4762a1bSJed Brown  call MatSetOption(L,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE,ierr); CHKERRA(ierr)
53*c4762a1bSJed Brown
54*c4762a1bSJed Brown  !call MatZeroEntries(L,ierr); CHKERRA(ierr)
55*c4762a1bSJed Brown
56*c4762a1bSJed Brown  ! assembling a diagonal matrix, adding a zero value to non-diagonal part
57*c4762a1bSJed Brown  do row = istart,iend-1
58*c4762a1bSJed Brown
59*c4762a1bSJed Brown    if (row == 0) then
60*c4762a1bSJed Brown      cols = [n-1]
61*c4762a1bSJed Brown      vals = [zero]
62*c4762a1bSJed Brown      rows = [row]
63*c4762a1bSJed Brown      call MatSetValues(L,i1,rows,i1,cols,vals,ADD_VALUES,ierr); CHKERRA(ierr)
64*c4762a1bSJed Brown    end if
65*c4762a1bSJed Brown    cols = [row]; vals = [one] ; rows = [ row];
66*c4762a1bSJed Brown    call MatSetValues(L,i1,rows,i1,cols,vals,ADD_VALUES,ierr); CHKERRA(ierr)
67*c4762a1bSJed Brown
68*c4762a1bSJed Brown  end do
69*c4762a1bSJed Brown
70*c4762a1bSJed Brown  call MatAssemblyBegin(L,MAT_FINAL_ASSEMBLY,ierr); CHKERRA(ierr)
71*c4762a1bSJed Brown  call MatAssemblyEnd(L,MAT_FINAL_ASSEMBLY,ierr); CHKERRA(ierr)
72*c4762a1bSJed Brown  call MatDestroy(L,ierr); CHKERRA(ierr)
73*c4762a1bSJed Brown
74*c4762a1bSJed Brown  call PetscFinalize(ierr)
75*c4762a1bSJed Brown
76*c4762a1bSJed Brownend program test_assembly
77*c4762a1bSJed Brown
78*c4762a1bSJed Brown!/*TEST
79*c4762a1bSJed Brown!
80*c4762a1bSJed Brown!   build:
81*c4762a1bSJed Brown!      requires: complex
82*c4762a1bSJed Brown!
83*c4762a1bSJed Brown!   test:
84*c4762a1bSJed Brown!      nsize: 2
85*c4762a1bSJed Brown!
86*c4762a1bSJed Brown!TEST*/
87