!
!   Modified from ex15f.F for testing MUMPS
!   Solves a linear system in parallel with KSP.
!  -------------------------------------------------------------------------

program main
#include <petsc/finclude/petscksp.h>
  use petscksp
  implicit none

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!                   Variable declarations
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  Vec x, b, u
  Mat A
  KSP ksp
  PetscScalar v, one, neg_one
  PetscReal norm, tol
  PetscErrorCode ierr
  PetscInt i, j, II, JJ, Istart
  PetscInt Iend, m, n, i1, its, five
  PetscMPIInt rank
  PetscBool flg
#if defined(PETSC_HAVE_MUMPS)
  PC pc
  Mat F
  PetscInt ival, icntl, infog34
  PetscReal cntl, rinfo12, rinfo13, val
#endif

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!                 Beginning of program
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  PetscCallA(PetscInitialize(ierr))
  one = 1.0
  neg_one = -1.0
  i1 = 1
  m = 8
  n = 7
  five = 5
  PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-m', m, flg, ierr))
  PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr))
  PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!      Compute the matrix and right-hand-side vector that define
!      the linear system, Ax = b.
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
  PetscCallA(MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, m*n, m*n, ierr))
  PetscCallA(MatSetType(A, MATAIJ, ierr))
  PetscCallA(MatSetFromOptions(A, ierr))
  PetscCallA(MatMPIAIJSetPreallocation(A, five, PETSC_NULL_INTEGER_ARRAY, five, PETSC_NULL_INTEGER_ARRAY, ierr))
  PetscCallA(MatSeqAIJSetPreallocation(A, five, PETSC_NULL_INTEGER_ARRAY, ierr))

  PetscCallA(MatGetOwnershipRange(A, Istart, Iend, ierr))

!  Set matrix elements for the 2-D, five-point stencil in parallel.
!   - Each processor needs to insert only elements that it owns
!     locally (but any non-local elements will be sent to the
!     appropriate processor during matrix assembly).
!   - Always specify global row and columns of matrix entries.
!   - Note that MatSetValues() uses 0-based row and column numbers
!     in Fortran as well as in C.
  do 10, II = Istart, Iend - 1
    v = -1.0
    i = II/n
    j = II - i*n
    if (i > 0) then
      JJ = II - n
      PetscCallA(MatSetValues(A, i1, [II], i1, [JJ], [v], ADD_VALUES, ierr))
    end if
    if (i < m - 1) then
      JJ = II + n
      PetscCallA(MatSetValues(A, i1, [II], i1, [JJ], [v], ADD_VALUES, ierr))
    end if
    if (j > 0) then
      JJ = II - 1
      PetscCallA(MatSetValues(A, i1, [II], i1, [JJ], [v], ADD_VALUES, ierr))
    end if
    if (j < n - 1) then
      JJ = II + 1
      PetscCallA(MatSetValues(A, i1, [II], i1, [JJ], [v], ADD_VALUES, ierr))
    end if
    v = 4.0
    PetscCallA(MatSetValues(A, i1, [II], i1, [II], [v], ADD_VALUES, ierr))
10  continue

!  Assemble matrix, using the 2-step process:
    PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
    PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))

!  Create parallel vectors.
    PetscCallA(VecCreateFromOptions(PETSC_COMM_WORLD, PETSC_NULL_CHARACTER, i1, PETSC_DECIDE, m*n, u, ierr))
    PetscCallA(VecDuplicate(u, b, ierr))
    PetscCallA(VecDuplicate(b, x, ierr))

!  Set exact solution; then compute right-hand-side vector.
    PetscCallA(VecSet(u, one, ierr))
    PetscCallA(MatMult(A, u, b, ierr))

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!         Create the linear solver and set various options
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    PetscCallA(KSPCreate(PETSC_COMM_WORLD, ksp, ierr))
    PetscCallA(KSPSetOperators(ksp, A, A, ierr))
    tol = 1.e-7
    PetscCallA(KSPSetTolerances(ksp, tol, PETSC_CURRENT_REAL, PETSC_CURRENT_REAL, PETSC_CURRENT_INTEGER, ierr))

!  Test MUMPS
#if defined(PETSC_HAVE_MUMPS)
    PetscCallA(KSPSetType(ksp, KSPPREONLY, ierr))
    PetscCallA(KSPGetPC(ksp, pc, ierr))
    PetscCallA(PCSetType(pc, PCLU, ierr))
    PetscCallA(PCFactorSetMatSolverType(pc, MATSOLVERMUMPS, ierr))
    PetscCallA(PCFactorSetUpMatSolverType(pc, ierr))
    PetscCallA(PCFactorGetMatrix(pc, F, ierr))

!     sequential ordering
    icntl = 7
    ival = 2
    PetscCallA(MatMumpsSetIcntl(F, icntl, ival, ierr))

!     threshold for row pivot detection
    icntl = 24
    ival = 1
    PetscCallA(MatMumpsSetIcntl(F, icntl, ival, ierr))
    icntl = 3
    val = 1.e-6
    PetscCallA(MatMumpsSetCntl(F, icntl, val, ierr))

!     compute determinant of A
    icntl = 33
    ival = 1
    PetscCallA(MatMumpsSetIcntl(F, icntl, ival, ierr))
#endif

    PetscCallA(KSPSetFromOptions(ksp, ierr))
    PetscCallA(KSPSetUp(ksp, ierr))
#if defined(PETSC_HAVE_MUMPS)
    icntl = 3
    PetscCallA(MatMumpsGetCntl(F, icntl, cntl, ierr))
    icntl = 34
    PetscCallA(MatMumpsGetInfog(F, icntl, infog34, ierr))
    icntl = 12
    PetscCallA(MatMumpsGetRinfog(F, icntl, rinfo12, ierr))
    icntl = 13
    PetscCallA(MatMumpsGetRinfog(F, icntl, rinfo13, ierr))
    if (rank == 0) then
      write (6, 98) cntl
      write (6, 99) rinfo12, rinfo13, infog34
    end if
98  format('Mumps row pivot threshold = ', 1pe11.2)
99  format('Mumps determinant=(', 1pe11.2, 1pe11.2, ')*2^', i3)
#endif

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!                      Solve the linear system
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    PetscCallA(KSPSolve(ksp, b, x, ierr))

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!                     Check solution and clean up
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    PetscCallA(VecAXPY(x, neg_one, u, ierr))
    PetscCallA(VecNorm(x, NORM_2, norm, ierr))
    PetscCallA(KSPGetIterationNumber(ksp, its, ierr))

    if (rank == 0) then
      if (norm > 1.e-12) then
        write (6, 100) norm, its
      else
        write (6, 110) its
      end if
    end if
100 format('Norm of error ', 1pe11.4, ' iterations ', i5)
110 format('Norm of error < 1.e-12,iterations ', i5)

!  Free work space.  All PETSc objects should be destroyed when they
!  are no longer needed.

    PetscCallA(KSPDestroy(ksp, ierr))
    PetscCallA(VecDestroy(u, ierr))
    PetscCallA(VecDestroy(x, ierr))
    PetscCallA(VecDestroy(b, ierr))
    PetscCallA(MatDestroy(A, ierr))

!  Always call PetscFinalize() before exiting a program.
    PetscCallA(PetscFinalize(ierr))
  end

!
!/*TEST
!
!   test:
!      suffix: mumps
!      nsize: 3
!      requires: mumps double
!      output_file: output/ex52f_1.out
!
!TEST*/
