Actual source code: ex44f.F90
1: program main ! Solves the linear system J x = f
2: #include <petsc/finclude/petscksp.h>
3: #include <petsc/finclude/petscdmda.h>
4: use petscmpi ! or mpi or mpi_f08
5: use petscksp
6: use petscdmda
7: implicit none
9: Vec x, f
10: Mat J
11: DM da
12: KSP ksp
13: PetscErrorCode ierr
14: PetscInt eight, one
16: eight = 8
17: one = 1
18: PetscCallA(PetscInitialize(ierr))
19: PetscCallA(DMDACreate1d(MPI_COMM_WORLD, DM_BOUNDARY_NONE, eight, one, one, PETSC_NULL_INTEGER_ARRAY, da, ierr))
20: PetscCallA(DMSetFromOptions(da, ierr))
21: PetscCallA(DMSetUp(da, ierr))
22: PetscCallA(DMCreateGlobalVector(da, x, ierr))
23: PetscCallA(VecDuplicate(x, f, ierr))
24: PetscCallA(DMSetMatType(da, MATAIJ, ierr))
25: PetscCallA(DMCreateMatrix(da, J, ierr))
27: PetscCallA(ComputeRHS(da, f, ierr))
28: PetscCallA(ComputeMatrix(da, J, ierr))
30: PetscCallA(KSPCreate(MPI_COMM_WORLD, ksp, ierr))
31: PetscCallA(KSPSetOperators(ksp, J, J, ierr))
32: PetscCallA(KSPSetFromOptions(ksp, ierr))
33: PetscCallA(KSPSolve(ksp, f, x, ierr))
35: PetscCallA(MatDestroy(J, ierr))
36: PetscCallA(VecDestroy(x, ierr))
37: PetscCallA(VecDestroy(f, ierr))
38: PetscCallA(KSPDestroy(ksp, ierr))
39: PetscCallA(DMDestroy(da, ierr))
40: PetscCallA(PetscFinalize(ierr))
42: contains
43: subroutine ComputeRHS(da, x, ierr)
44: use petscdmda
45: implicit none
47: DM da
48: Vec x
49: PetscErrorCode ierr
50: PetscInt xs, xm, i, mx
51: PetscScalar hx
52: PetscScalar, pointer :: xx(:)
53: PetscCall(DMDAGetInfo(da, PETSC_NULL_INTEGER, mx, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_DMBOUNDARYTYPE, PETSC_NULL_DMBOUNDARYTYPE, PETSC_NULL_DMBOUNDARYTYPE, PETSC_NULL_DMDASTENCILTYPE, ierr))
54: PetscCall(DMDAGetCorners(da, xs, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, xm, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, ierr))
55: hx = 1.0_PETSC_REAL_KIND/(mx - 1)
56: PetscCall(DMDAVecGetArray(da, x, xx, ierr))
57: do i = xs, xs + xm - 1
58: xx(i) = i*hx
59: end do
60: PetscCall(DMDAVecRestoreArray(da, x, xx, ierr))
61: end
63: subroutine ComputeMatrix(da, J, ierr)
64: use petscdmda
65: use petscmat
66: implicit none
68: Mat J
69: DM da
70: PetscErrorCode ierr
71: PetscInt xs, xm, i, mx
72: PetscScalar hx, one
74: one = 1.0
75: PetscCall(DMDAGetInfo(da, PETSC_NULL_INTEGER, mx, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_DMBOUNDARYTYPE, PETSC_NULL_DMBOUNDARYTYPE, PETSC_NULL_DMBOUNDARYTYPE, PETSC_NULL_DMDASTENCILTYPE, ierr))
76: PetscCall(DMDAGetCorners(da, xs, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, xm, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, ierr))
77: hx = 1.0_PETSC_REAL_KIND/(mx - 1)
78: do i = xs, xs + xm - 1
79: if ((i == 0) .or. (i == mx - 1)) then
80: PetscCall(MatSetValue(J, i, i, one, INSERT_VALUES, ierr))
81: else
82: PetscCall(MatSetValue(J, i, i - 1, -hx, INSERT_VALUES, ierr))
83: PetscCall(MatSetValue(J, i, i + 1, -hx, INSERT_VALUES, ierr))
84: PetscCall(MatSetValue(J, i, i, 2*hx, INSERT_VALUES, ierr))
85: end if
86: end do
87: PetscCall(MatAssemblyBegin(J, MAT_FINAL_ASSEMBLY, ierr))
88: PetscCall(MatAssemblyEnd(J, MAT_FINAL_ASSEMBLY, ierr))
89: end
90: end program
91: !/*TEST
92: !
93: ! test:
94: ! args: -ksp_converged_reason
95: !
96: !TEST*/