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 .eq. 0,PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISCreateStride')

 26:       PetscCallA(ISStrideGetInfo(is,start,stride,ierr))
 27:       PetscCheckA(start .eq. 0,PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISStrideGetInfo')
 28:       PetscCheckA(stride .eq. 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(ISGetIndicesF90(is,ii,ierr))
 33:       PetscCallA(ISRestoreIndicesF90(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(ISGetIndicesF90(is,ii,ierr))
 44:       do 10, i=1,n
 45:         PetscCheckA(ii(i) .eq. -11 + 3*i,PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISGetIndices')
 46:  10   continue
 47:       PetscCallA(ISRestoreIndicesF90(is,ii,ierr))
 48:       PetscCallA(ISDestroy(is,ierr))

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

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