Actual source code: ex126f.F
petsc-3.7.4 2016-10-02
1: !
2: ! This program is modified from a user's contribution.
3: ! It illustrates how to call MUMPS's LU solver
4: !
6: program main
7: implicit none
9: #include <petsc/finclude/petscsys.h>
10: #include <petsc/finclude/petscvec.h>
11: #include <petsc/finclude/petscmat.h>
13: Vec x,b,u
14: Mat A, fact
15: PetscInt i,j,II,JJ,m
16: PetscInt Istart, Iend
17: PetscInt ione, ifive
18: PetscBool wmumps
19: PetscBool flg
20: PetscScalar one, v
21: IS perm,iperm
22: PetscErrorCode ierr
23: PetscReal info(MAT_FACTORINFO_SIZE)
25: call PetscInitialize(PETSC_NULL_CHARACTER, ierr)
26: m = 10
27: one = 1.0
28: ione = 1
29: ifive = 5
31: wmumps = PETSC_FALSE
33: call PetscOptionsGetInt(PETSC_NULL_OBJECT,PETSC_NULL_CHARACTER, &
34: & '-m',m,flg, ierr)
35: call PetscOptionsGetBool(PETSC_NULL_OBJECT,PETSC_NULL_CHARACTER, &
36: & '-use_mumps',wmumps,flg,ierr)
38: call MatCreate(PETSC_COMM_WORLD, A, ierr)
39: call MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, m*m, m*m, ierr)
40: call MatSetType(A, MATAIJ, ierr)
41: call MatSetFromOptions(A, ierr)
42: call MatSeqAIJSetPreallocation(A,ifive, PETSC_NULL_INTEGER, ierr)
43: call MatMPIAIJSetPreallocation(A,ifive,PETSC_NULL_INTEGER,ifive, &
44: & PETSC_NULL_INTEGER,ierr)
46: call MatGetOwnershipRange(A,Istart,Iend,ierr)
48: do 10, II=Istart,Iend - 1
49: v = -1.0
50: i = II/m
51: j = II - i*m
52: if (i.gt.0) then
53: JJ = II - m
54: call MatSetValues(A,ione,II,ione,JJ,v,INSERT_VALUES,ierr)
55: endif
56: if (i.lt.m-1) then
57: JJ = II + m
58: call MatSetValues(A,ione,II,ione,JJ,v,INSERT_VALUES,ierr)
59: endif
60: if (j.gt.0) then
61: JJ = II - 1
62: call MatSetValues(A,ione,II,ione,JJ,v,INSERT_VALUES,ierr)
63: endif
64: if (j.lt.m-1) then
65: JJ = II + 1
66: call MatSetValues(A,ione,II,ione,JJ,v,INSERT_VALUES,ierr)
67: endif
68: v = 4.0
69: call MatSetValues(A,ione,II,ione,II,v,INSERT_VALUES,ierr)
70: 10 continue
72: call MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr)
73: call MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr)
75: call VecCreate(PETSC_COMM_WORLD, u, ierr)
76: call VecSetSizes(u, PETSC_DECIDE, m*m, ierr)
77: call VecSetFromOptions(u, ierr)
78: call VecDuplicate(u,b,ierr)
79: call VecDuplicate(b,x,ierr)
80: call VecSet(u, one, ierr)
81: call MatMult(A, u, b, ierr)
83: call MatFactorInfoInitialize(info,ierr)
84: if (wmumps) then
85: write(*,*) 'use MUMPS LU...'
86: call MatGetFactor(A,MATSOLVERMUMPS,MAT_FACTOR_LU,fact,ierr)
87: call MatLUFactorSymbolic(fact, A, PETSC_NULL_OBJECT, &
88: & PETSC_NULL_OBJECT,info, ierr)
89: else
90: write(*,*) 'use PETSc LU...'
91: call MatGetOrdering(A,MATORDERINGNATURAL,perm,iperm,ierr)
92: call MatGetFactor(A,MATSOLVERPETSC,MAT_FACTOR_LU,fact,ierr)
94: call MatLUFactorSymbolic(fact, A, perm, iperm, &
95: & info, ierr)
96: call ISDestroy(perm,ierr)
97: call ISDestroy(iperm,ierr)
98: endif
100: call MatLUFactorNumeric(fact, A, info, ierr)
101: call MatSolve(fact, b, x,ierr)
102: call MatDestroy(fact, ierr)
104: call MatDestroy(A, ierr)
105: call VecDestroy(u, ierr)
106: call VecDestroy(x, ierr)
107: call VecDestroy(b, ierr)
109: call PetscFinalize(ierr)
110: end