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*/