Actual source code: ex126f.F
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: #include <petsc/finclude/petscmat.h>
8: use petscmat
9: implicit none
11: Vec x,b,u
12: Mat A, fact
13: PetscInt i,j,II,JJ,m
14: PetscInt Istart, Iend
15: PetscInt ione, ifive
16: PetscBool wmumps
17: PetscBool flg
18: PetscScalar one, v
19: IS perm,iperm
20: PetscErrorCode ierr
21: PetscReal info(MAT_FACTORINFO_SIZE)
23: call PetscInitialize(PETSC_NULL_CHARACTER, ierr)
24: if (ierr .ne. 0) then
25: print*,'Unable to initialize PETSc'
26: stop
27: endif
28: m = 10
29: one = 1.0
30: ione = 1
31: ifive = 5
33: wmumps = PETSC_FALSE
35: call PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER, &
36: & '-m',m,flg, ierr)
37: call PetscOptionsGetBool(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER, &
38: & '-use_mumps',wmumps,flg,ierr)
40: call MatCreate(PETSC_COMM_WORLD, A, ierr)
41: call MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, m*m, m*m, ierr)
42: call MatSetType(A, MATAIJ, ierr)
43: call MatSetFromOptions(A, ierr)
44: call MatSeqAIJSetPreallocation(A,ifive, PETSC_NULL_INTEGER, ierr)
45: call MatMPIAIJSetPreallocation(A,ifive,PETSC_NULL_INTEGER,ifive, &
46: & PETSC_NULL_INTEGER,ierr)
48: call MatGetOwnershipRange(A,Istart,Iend,ierr)
50: do 10, II=Istart,Iend - 1
51: v = -1.0
52: i = II/m
53: j = II - i*m
54: if (i.gt.0) then
55: JJ = II - m
56: call MatSetValues(A,ione,II,ione,JJ,v,INSERT_VALUES,ierr)
57: endif
58: if (i.lt.m-1) then
59: JJ = II + m
60: call MatSetValues(A,ione,II,ione,JJ,v,INSERT_VALUES,ierr)
61: endif
62: if (j.gt.0) then
63: JJ = II - 1
64: call MatSetValues(A,ione,II,ione,JJ,v,INSERT_VALUES,ierr)
65: endif
66: if (j.lt.m-1) then
67: JJ = II + 1
68: call MatSetValues(A,ione,II,ione,JJ,v,INSERT_VALUES,ierr)
69: endif
70: v = 4.0
71: call MatSetValues(A,ione,II,ione,II,v,INSERT_VALUES,ierr)
72: 10 continue
74: call MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr)
75: call MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr)
77: call VecCreate(PETSC_COMM_WORLD, u, ierr)
78: call VecSetSizes(u, PETSC_DECIDE, m*m, ierr)
79: call VecSetFromOptions(u, ierr)
80: call VecDuplicate(u,b,ierr)
81: call VecDuplicate(b,x,ierr)
82: call VecSet(u, one, ierr)
83: call MatMult(A, u, b, ierr)
85: call MatFactorInfoInitialize(info,ierr)
86: call MatGetOrdering(A,MATORDERINGNATURAL,perm,iperm,ierr)
87: if (wmumps) then
88: write(*,*) 'use MUMPS LU...'
89: call MatGetFactor(A,MATSOLVERMUMPS,MAT_FACTOR_LU,fact,ierr)
90: else
91: write(*,*) 'use PETSc LU...'
92: call MatGetFactor(A,MATSOLVERPETSC,MAT_FACTOR_LU,fact,ierr)
93: endif
94: call MatLUFactorSymbolic(fact, A, perm, iperm, &
95: & info, ierr)
96: call ISDestroy(perm,ierr)
97: call ISDestroy(iperm,ierr)
99: call MatLUFactorNumeric(fact, A, info, ierr)
100: call MatSolve(fact, b, x,ierr)
101: call MatDestroy(fact, ierr)
103: call MatDestroy(A, ierr)
104: call VecDestroy(u, ierr)
105: call VecDestroy(x, ierr)
106: call VecDestroy(b, ierr)
108: call PetscFinalize(ierr)
109: end
111: !/*TEST
112: !
113: ! test:
114: !
115: ! test:
116: ! suffix: 2
117: ! args: -use_mumps
118: ! requires: mumps
119: !
120: !TEST*/