Actual source code: ex2f.F90

  1: !
  2: !  Formatted Test for IS stride routines
  3: !
  4: program main
  5: #include <petsc/finclude/petscis.h>
  6:   use petscis
  7:   implicit none

  9:   PetscErrorCode ierr
 10:   PetscInt i, n, start
 11:   PetscInt stride, ssize, first
 12:   IS is
 13:   PetscBool flag
 14:   PetscInt, pointer :: ii(:)

 16:   PetscCallA(PetscInitialize(ierr))

 18: !     Test IS of size 0
 19:   ssize = 0
 20:   stride = 0
 21:   first = 2
 22:   PetscCallA(ISCreateStride(PETSC_COMM_SELF, ssize, stride, first, is, ierr))
 23:   PetscCallA(ISGetLocalSize(is, n, ierr))
 24:   PetscCheckA(n == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, 'Wrong result from ISCreateStride')

 26:   PetscCallA(ISStrideGetInfo(is, start, stride, ierr))
 27:   PetscCheckA(start == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, 'Wrong result from ISStrideGetInfo')
 28:   PetscCheckA(stride == 2, PETSC_COMM_SELF, PETSC_ERR_PLIB, 'Wrong result from ISStrideGetInfo')

 30:   PetscCallA(PetscObjectTypeCompare(is, ISSTRIDE, flag, ierr))
 31:   PetscCheckA(flag, PETSC_COMM_SELF, PETSC_ERR_PLIB, 'Wrong result from PetscObjectTypeCompare')
 32:   PetscCallA(ISGetIndices(is, ii, ierr))
 33:   PetscCallA(ISRestoreIndices(is, ii, ierr))
 34:   PetscCallA(ISDestroy(is, ierr))

 36: !     Test ISGetIndices()

 38:   ssize = 10000
 39:   stride = -8
 40:   first = 3
 41:   PetscCallA(ISCreateStride(PETSC_COMM_SELF, ssize, stride, first, is, ierr))
 42:   PetscCallA(ISGetLocalSize(is, n, ierr))
 43:   PetscCallA(ISGetIndices(is, ii, ierr))
 44:   do 10, i = 1, n
 45:     PetscCheckA(ii(i) == -11 + 3*i, PETSC_COMM_SELF, PETSC_ERR_PLIB, 'Wrong result from ISGetIndices')
 46: 10  continue
 47:     PetscCallA(ISRestoreIndices(is, ii, ierr))
 48:     PetscCallA(ISDestroy(is, ierr))

 50:     PetscCallA(PetscFinalize(ierr))
 51:   end

 53: !/*TEST
 54: !
 55: !   test:
 56: !     output_file: output/empty.out
 57: !
 58: !TEST*/