!
!  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  SLEPc - Scalable Library for Eigenvalue Problem Computations
!  Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain
!
!  This file is part of SLEPc.
!  SLEPc is distributed under a 2-clause BSD license (see LICENSE).
!  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!  Program usage: mpiexec -n <np> ./test7f [-help] [-n <n>] [all SLEPc options]
!
!  Description: Simple example that solves an eigensystem with the EPS object.
!  Same problem as ex1f but with simplified output.
!
!  The command line options are:
!    -n <n>, where <n> = number of grid points = matrix size
!
! ----------------------------------------------------------------------
!
#include <slepc/finclude/slepceps.h>
program test7f
  use slepceps
  implicit none

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Declarations
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  Mat            :: A     ! operator matrix
  EPS            :: eps   ! eigenproblem solver context
  EPSType        :: tname
  PetscInt       :: n, i, Istart, Iend
  PetscInt       :: nev, nini
  PetscInt       :: col(3)
  PetscInt       :: i0, i1, i2, i3
  PetscMPIInt    :: rank
  PetscErrorCode :: ierr
  PetscBool      :: flg
  PetscScalar    :: val(3)
  Vec            :: v
  PetscScalar, parameter :: one = 1.0

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Beginning of program
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
  PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
  n = 30
  PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr))

  if (rank == 0) then
    write (*, '(/a,i3,a)') '1-D Laplacian Eigenproblem, n =', n, ' (Fortran)'
  end if

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Compute the operator matrix that defines the eigensystem, Ax=kx
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
  PetscCallA(MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, n, n, ierr))
  PetscCallA(MatSetFromOptions(A, ierr))

  i0 = 0
  i1 = 1
  i2 = 2
  i3 = 3
  PetscCallA(MatGetOwnershipRange(A, Istart, Iend, ierr))
  if (Istart == 0) then
    i = 0
    col(1) = 0
    col(2) = 1
    val(1) = 2.0
    val(2) = -1.0
    PetscCallA(MatSetValues(A, i1, [i], i2, col, val, INSERT_VALUES, ierr))
    Istart = Istart + 1
  end if
  if (Iend == n) then
    i = n - 1
    col(1) = n - 2
    col(2) = n - 1
    val(1) = -1.0
    val(2) = 2.0
    PetscCallA(MatSetValues(A, i1, [i], i2, col, val, INSERT_VALUES, ierr))
    Iend = Iend - 1
  end if
  val(1) = -1.0
  val(2) = 2.0
  val(3) = -1.0
  do i = Istart, Iend - 1
    col(1) = i - 1
    col(2) = i
    col(3) = i + 1
    PetscCallA(MatSetValues(A, i1, [i], i3, col, val, INSERT_VALUES, ierr))
  end do

  PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
  PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))

  PetscCallA(MatCreateVecs(A, v, PETSC_NULL_VEC, ierr))
  if (Istart == 0) then
    PetscCallA(VecSetValue(v, i0, one, INSERT_VALUES, ierr))
  end if
  PetscCallA(VecAssemblyBegin(v, ierr))
  PetscCallA(VecAssemblyEnd(v, ierr))

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Create the eigensolver and display info
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

! ** Create eigensolver context
  PetscCallA(EPSCreate(PETSC_COMM_WORLD, eps, ierr))

! ** Set operators. In this case, it is a standard eigenvalue problem
  PetscCallA(EPSSetOperators(eps, A, PETSC_NULL_MAT, ierr))
  PetscCallA(EPSSetProblemType(eps, EPS_HEP, ierr))

! ** Set solver parameters at runtime
  PetscCallA(EPSSetFromOptions(eps, ierr))

! ** Set initial vectors
  nini = 1
  PetscCallA(EPSSetInitialSpace(eps, nini, [v], ierr))

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!     Solve the eigensystem
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  PetscCallA(EPSSolve(eps, ierr))

! ** Optional: Get some information from the solver and display it
  PetscCallA(EPSGetType(eps, tname, ierr))
  if (rank == 0) then
    write (*, '(a,a)') ' Solution method: ', tname
  end if
  PetscCallA(EPSGetDimensions(eps, nev, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, ierr))
  if (rank == 0) then
    write (*, '(a,i2)') ' Number of requested eigenvalues:', nev
  end if

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Display solution and clean up
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  PetscCallA(EPSErrorView(eps, EPS_ERROR_RELATIVE, PETSC_NULL_VIEWER, ierr))
  PetscCallA(EPSDestroy(eps, ierr))
  PetscCallA(MatDestroy(A, ierr))
  PetscCallA(VecDestroy(v, ierr))

  PetscCallA(SlepcFinalize(ierr))
end program test7f

!/*TEST
!
!   test:
!      suffix: 1
!      args: -eps_nev 4 -eps_ncv 19
!      filter: sed -e "s/83791/83792/"
!
!TEST*/
