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

!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!                   Variable declarations
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!  Variables:
!     x, y, w - vectors
!     z       - array of vectors
!
  type(tVec) x, y, w
  type(tVec), pointer :: z(:)

  PetscReal norm, v, v1, v2, nfloat
  PetscInt n
  PetscErrorCode ierr
  PetscMPIInt rank
  PetscBool flg
  PetscScalar, parameter :: one = 1.0, two = 2.0, three = 3.0
  PetscScalar dots(3), dot
  PetscReal, parameter :: tol = 1.e-10_PETSC_REAL_KIND

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

  PetscCallA(PetscInitialize(ierr))

  n = 20
  PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr))
  nfloat = real(n, PETSC_REAL_KIND)
  PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))

!  Create a vector, specifying only its global dimension.
!  When using VecCreate(), VecSetSizes() and VecSetFromOptions(),
!  the vector format (currently parallel
!  or sequential) is determined at runtime.  Also, the parallel
!  partitioning of the vector is determined by PETSc at runtime.
!
  PetscCallA(VecCreate(PETSC_COMM_WORLD, x, ierr))
  PetscCallA(VecSetSizes(x, PETSC_DECIDE, n, ierr))
  PetscCallA(VecSetFromOptions(x, ierr))

!  Duplicate some work vectors (of the same format and
!  partitioning as the initial vector).

  PetscCallA(VecDuplicate(x, y, ierr))
  PetscCallA(VecDuplicate(x, w, ierr))

!  Duplicate more work vectors (of the same format and
!  partitioning as the initial vector).  Here we duplicate
!  an array of vectors, which is often more convenient than
!  duplicating individual ones.

  PetscCallA(VecDuplicateVecs(x, 3_PETSC_INT_KIND, z, ierr))

!  Set the vectors to entries to a constant value.

  PetscCallA(VecSet(x, one, ierr))
  PetscCallA(VecSet(y, two, ierr))
  PetscCallA(VecSet(z(1), one, ierr))
  PetscCallA(VecSet(z(2), two, ierr))
  PetscCallA(VecSet(z(3), three, ierr))

!  Demonstrate various basic vector routines.

  PetscCallA(VecDot(x, x, dot, ierr))
  PetscCallA(VecMDot(x, 3_PETSC_INT_KIND, z, dots, ierr))

!  Note: If using a complex numbers version of PETSc, then
!  PETSC_USE_COMPLEX is defined in the makefiles; otherwise,
!  (when using real numbers) it is undefined.

  if (rank == 0) then
#if defined(PETSC_USE_COMPLEX)
    write (6, 100) int(PetscRealPart(dot))
    write (6, 110) int(PetscRealPart(dots(1))), int(PetscRealPart(dots(2))), int(PetscRealPart(dots(3)))
#else
    write (6, 100) int(dot)
    write (6, 110) int(dots(1)), int(dots(2)), int(dots(3))
#endif
    write (6, 120)
  end if
100 format('Vector length ', i6)
110 format('Vector length ', 3(i6))
120 format('All other values should be near zero')

  PetscCallA(VecScale(x, two, ierr))
  PetscCallA(VecNorm(x, NORM_2, norm, ierr))
  v = abs(norm - 2.0*sqrt(nfloat))
  if (v > -tol .and. v < tol) v = 0.0
  if (rank == 0) write (6, 130) v
130 format('VecScale ', 1pe9.2)

  PetscCallA(VecCopy(x, w, ierr))
  PetscCallA(VecNorm(w, NORM_2, norm, ierr))
  v = abs(norm - 2.0*sqrt(nfloat))
  if (v > -tol .and. v < tol) v = 0.0
  if (rank == 0) write (6, 140) v
140 format('VecCopy ', 1pe9.2)

  PetscCallA(VecAXPY(y, three, x, ierr))
  PetscCallA(VecNorm(y, NORM_2, norm, ierr))
  v = abs(norm - 8.0*sqrt(nfloat))
  if (v > -tol .and. v < tol) v = 0.0
  if (rank == 0) write (6, 150) v
150 format('VecAXPY ', 1pe9.2)

  PetscCallA(VecAYPX(y, two, x, ierr))
  PetscCallA(VecNorm(y, NORM_2, norm, ierr))
  v = abs(norm - 18.0*sqrt(nfloat))
  if (v > -tol .and. v < tol) v = 0.0
  if (rank == 0) write (6, 160) v
160 format('VecAYXP ', 1pe9.2)

  PetscCallA(VecSwap(x, y, ierr))
  PetscCallA(VecNorm(y, NORM_2, norm, ierr))
  v = abs(norm - 2.0*sqrt(nfloat))
  if (v > -tol .and. v < tol) v = 0.0
  if (rank == 0) write (6, 170) v
170 format('VecSwap ', 1pe9.2)

  PetscCallA(VecNorm(x, NORM_2, norm, ierr))
  v = abs(norm - 18.0*sqrt(nfloat))
  if (v > -tol .and. v < tol) v = 0.0
  if (rank == 0) write (6, 180) v
180 format('VecSwap ', 1pe9.2)

  PetscCallA(VecWAXPY(w, two, x, y, ierr))
  PetscCallA(VecNorm(w, NORM_2, norm, ierr))
  v = abs(norm - 38.0*sqrt(nfloat))
  if (v > -tol .and. v < tol) v = 0.0
  if (rank == 0) write (6, 190) v
190 format('VecWAXPY ', 1pe9.2)

  PetscCallA(VecPointwiseMult(w, y, x, ierr))
  PetscCallA(VecNorm(w, NORM_2, norm, ierr))
  v = abs(norm - 36.0*sqrt(nfloat))
  if (v > -tol .and. v < tol) v = 0.0
  if (rank == 0) write (6, 200) v
200 format('VecPointwiseMult ', 1pe9.2)

  PetscCallA(VecPointwiseDivide(w, x, y, ierr))
  PetscCallA(VecNorm(w, NORM_2, norm, ierr))
  v = abs(norm - 9.0*sqrt(nfloat))
  if (v > -tol .and. v < tol) v = 0.0
  if (rank == 0) write (6, 210) v
210 format('VecPointwiseDivide ', 1pe9.2)

  dots(1) = one
  dots(2) = three
  dots(3) = two
  PetscCallA(VecSet(x, one, ierr))
  PetscCallA(VecMAXPY(x, 3_PETSC_INT_KIND, dots, z, ierr))
  PetscCallA(VecNorm(z(1), NORM_2, norm, ierr))
  v = abs(norm - sqrt(nfloat))
  if (v > -tol .and. v < tol) v = 0.0
  PetscCallA(VecNorm(z(2), NORM_2, norm, ierr))
  v1 = abs(norm - 2.0*sqrt(nfloat))
  if (v1 > -tol .and. v1 < tol) v1 = 0.0
  PetscCallA(VecNorm(z(3), NORM_2, norm, ierr))
  v2 = abs(norm - 3.0*sqrt(nfloat))
  if (v2 > -tol .and. v2 < tol) v2 = 0.0
  if (rank == 0) write (6, 220) v, v1, v2
220 format('VecMAXPY ', 3(1pe9.2))

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

  PetscCallA(VecDestroy(x, ierr))
  PetscCallA(VecDestroy(y, ierr))
  PetscCallA(VecDestroy(w, ierr))
  PetscCallA(VecDestroyVecs(3_PETSC_INT_KIND, z, ierr))
  PetscCallA(PetscFinalize(ierr))

end

!/*TEST
!
!     test:
!
!TEST*/
