Actual source code: ex52f.F90
1: !
2: program main
3: #include <petsc/finclude/petscksp.h>
4: use petscksp
5: implicit none
6: !
7: ! Demonstrates using MatFactorGetError() and MatFactorGetErrorZeroPivot()
8: !
10: PetscErrorCode ierr
11: PetscInt m, n, one, row, col
12: Vec x, b
13: Mat A, F
14: KSP ksp
15: PetscScalar two, zero
16: KSPConvergedReason reason
17: PCFailedReason pcreason
18: PC pc
19: MatFactorError ferr
20: PetscReal pivot
22: PetscCallA(PetscInitialize(ierr))
23: m = 2
24: n = 2
25: PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
26: PetscCallA(MatSetSizes(A, m, n, m, n, ierr))
27: PetscCallA(MatSetType(A, MATSEQAIJ, ierr))
28: PetscCallA(MatSetUp(A, ierr))
29: row = 0
30: col = 0
31: two = 2.0
32: one = 1
33: PetscCallA(MatSetValues(A, one, [row], one, [col], [two], INSERT_VALUES, ierr))
34: row = 1
35: col = 1
36: zero = 0.0
37: PetscCallA(MatSetValues(A, one, [row], one, [col], [zero], INSERT_VALUES, ierr))
38: PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
39: PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))
41: PetscCallA(VecCreate(PETSC_COMM_WORLD, b, ierr))
42: PetscCallA(VecSetSizes(b, m, m, ierr))
43: PetscCallA(VecSetType(b, VECSEQ, ierr))
45: ! Set up solution
46: PetscCallA(VecDuplicate(b, x, ierr))
48: ! Solve system
49: PetscCallA(KSPCreate(PETSC_COMM_WORLD, ksp, ierr))
50: PetscCallA(KSPSetOperators(ksp, A, A, ierr))
51: PetscCallA(KSPSetFromOptions(ksp, ierr))
52: PetscCallA(KSPSolve(ksp, b, x, ierr))
53: PetscCallA(KSPGetConvergedReason(ksp, reason, ierr))
54: PetscCallA(KSPGetPC(ksp, pc, ierr))
55: PetscCallA(PCGetFailedReason(pc, pcreason, ierr))
56: PetscCallA(PCFactorGetMatrix(pc, F, ierr))
57: PetscCallA(MatFactorGetError(F, ferr, ierr))
58: PetscCallA(MatFactorGetErrorZeroPivot(F, pivot, row, ierr))
59: write (6, 101) ferr, pivot, row
60: 101 format('MatFactorError ', i4, ' Pivot value ', 1pe9.2, ' row ', i4)
62: ! Cleanup
63: PetscCallA(KSPDestroy(ksp, ierr))
64: PetscCallA(VecDestroy(b, ierr))
65: PetscCallA(VecDestroy(x, ierr))
66: PetscCallA(MatDestroy(A, ierr))
68: PetscCallA(PetscFinalize(ierr))
69: end
71: ! Nag compiler automatically turns on catching of floating point exceptions and prints message at
72: ! end of run about the exceptions seen
73: !
74: !/*TEST
75: !
76: ! test:
77: ! args: -fp_trap 0
78: ! filter: grep -v "Warning: Floating"
79: !
80: !TEST*/