Actual source code: ex22f.F90

  1: !
  2: !   Laplacian in 3D. Modeled by the partial differential equation
  3: !
  4: !   Laplacian u = 1,0 < x,y,z < 1,
  5: !
  6: !   with boundary conditions
  7: !
  8: !   u = 1 for x = 0, x = 1, y = 0, y = 1, z = 0, z = 1.
  9: !
 10: !   This uses multigrid to solve the linear system

 12: program main
 13: #include <petsc/finclude/petscdmda.h>
 14: #include <petsc/finclude/petscksp.h>
 15:   use petscdmda
 16:   use petscksp
 17:   implicit none

 19:   PetscErrorCode ierr
 20:   DM da
 21:   KSP ksp
 22:   Vec x
 23:   external ComputeRHS, ComputeMatrix
 24:   PetscInt i1, i3
 25:   PetscInt ctx

 27:   PetscCallA(PetscInitialize(ierr))

 29:   i3 = 3
 30:   i1 = 1
 31:   PetscCallA(KSPCreate(PETSC_COMM_WORLD, ksp, ierr))
 32:   PetscCallA(DMDACreate3d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DMDA_STENCIL_STAR, i3, i3, i3, PETSC_DECIDE, PETSC_DECIDE, PETSC_DECIDE, i1, i1, PETSC_NULL_INTEGER_ARRAY, PETSC_NULL_INTEGER_ARRAY, PETSC_NULL_INTEGER_ARRAY, da, ierr))
 33:   PetscCallA(DMSetFromOptions(da, ierr))
 34:   PetscCallA(DMSetUp(da, ierr))
 35:   PetscCallA(KSPSetDM(ksp, da, ierr))
 36:   PetscCallA(KSPSetComputeRHS(ksp, ComputeRHS, ctx, ierr))
 37:   PetscCallA(KSPSetComputeOperators(ksp, ComputeMatrix, ctx, ierr))

 39:   PetscCallA(KSPSetFromOptions(ksp, ierr))
 40:   PetscCallA(KSPSolve(ksp, PETSC_NULL_VEC, PETSC_NULL_VEC, ierr))
 41:   PetscCallA(KSPGetSolution(ksp, x, ierr))
 42:   PetscCallA(KSPDestroy(ksp, ierr))
 43:   PetscCallA(DMDestroy(da, ierr))
 44:   PetscCallA(PetscFinalize(ierr))

 46: end

 48: subroutine ComputeRHS(ksp, b, ctx, ierr)
 49:   use petscksp
 50:   implicit none

 52:   PetscErrorCode ierr
 53:   PetscInt mx, my, mz
 54:   PetscScalar h
 55:   Vec b
 56:   KSP ksp
 57:   DM da
 58:   PetscInt ctx

 60:   PetscCall(KSPGetDM(ksp, da, ierr))
 61:   PetscCall(DMDAGetInfo(da, PETSC_NULL_INTEGER, mx, my, mz, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, ierr))
 62:   h = 1.0/real((mx - 1)*(my - 1)*(mz - 1))

 64:   PetscCall(VecSet(b, h, ierr))
 65: end

 67: subroutine ComputeMatrix(ksp, JJ, jac, ctx, ierr)
 68:   use petscksp
 69:   implicit none

 71:   Mat jac, JJ
 72:   PetscErrorCode ierr
 73:   KSP ksp
 74:   DM da
 75:   PetscInt i, j, k, mx, my, mz, xm
 76:   PetscInt ym, zm, xs, ys, zs, i1, i7
 77:   PetscScalar v(7), Hx, Hy, Hz
 78:   PetscScalar HxHydHz, HyHzdHx
 79:   PetscScalar HxHzdHy
 80:   MatStencil row(1), col(7)
 81:   PetscInt ctx
 82:   i1 = 1
 83:   i7 = 7
 84:   PetscCall(KSPGetDM(ksp, da, ierr))
 85:   PetscCall(DMDAGetInfo(da, PETSC_NULL_INTEGER, mx, my, mz, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, ierr))

 87:   Hx = 1.0/real(mx - 1)
 88:   Hy = 1.0/real(my - 1)
 89:   Hz = 1.0/real(mz - 1)
 90:   HxHydHz = Hx*Hy/Hz
 91:   HxHzdHy = Hx*Hz/Hy
 92:   HyHzdHx = Hy*Hz/Hx
 93:   PetscCall(DMDAGetCorners(da, xs, ys, zs, xm, ym, zm, ierr))

 95:   do 10, k = zs, zs + zm - 1
 96:     do 20, j = ys, ys + ym - 1
 97:       do 30, i = xs, xs + xm - 1
 98:         row(1)%i = i
 99:         row(1)%j = j
100:         row(1)%k = k
101:         if (i == 0 .or. j == 0 .or. k == 0 .or. i == mx - 1 .or. j == my - 1 .or. k == mz - 1) then
102:           v(1) = 2.0*(HxHydHz + HxHzdHy + HyHzdHx)
103:           PetscCall(MatSetValuesStencil(jac, i1, row, i1, row, v, INSERT_VALUES, ierr))
104:         else
105:           v(1) = -HxHydHz
106:           col(1)%i = i
107:           col(1)%j = j
108:           col(1)%k = k - 1
109:           v(2) = -HxHzdHy
110:           col(2)%i = i
111:           col(2)%j = j - 1
112:           col(2)%k = k
113:           v(3) = -HyHzdHx
114:           col(3)%i = i - 1
115:           col(3)%j = j
116:           col(3)%k = k
117:           v(4) = 2.0*(HxHydHz + HxHzdHy + HyHzdHx)
118:           col(4)%i = i
119:           col(4)%j = j
120:           col(4)%k = k
121:           v(5) = -HyHzdHx
122:           col(5)%i = i + 1
123:           col(5)%j = j
124:           col(5)%k = k
125:           v(6) = -HxHzdHy
126:           col(6)%i = i
127:           col(6)%j = j + 1
128:           col(6)%k = k
129:           v(7) = -HxHydHz
130:           col(7)%i = i
131:           col(7)%j = j
132:           col(7)%k = k + 1
133:           PetscCall(MatSetValuesStencil(jac, i1, row, i7, col, v, INSERT_VALUES, ierr))
134:         end if
135: 30      continue
136: 20      continue
137: 10      continue

139:         PetscCall(MatAssemblyBegin(jac, MAT_FINAL_ASSEMBLY, ierr))
140:         PetscCall(MatAssemblyEnd(jac, MAT_FINAL_ASSEMBLY, ierr))
141:       end

143: !/*TEST
144: !
145: !   test:
146: !      args: -pc_mg_type full -ksp_monitor_short -mg_levels_ksp_monitor_short -mg_levels_ksp_norm_type preconditioned -pc_type mg -da_refine 2 -ksp_type fgmres
147: !      requires: !single
148: !      output_file: output/ex22_1.out
149: !
150: !TEST*/