Actual source code: ex2f.F

petsc-3.7.2 2016-06-05
Report Typos and Errors
  1: !
  2: !  Formatted Test for IS stride routines
  3: !
  4:       program main
  5:       implicit none
  6: #include <petsc/finclude/petscsys.h>
  7: #include <petsc/finclude/petscis.h>

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

 16:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)

 18: !     Test IS of size 0
 19:       ssize = 0
 20:       stride = 0
 21:       first = 2
 22:       call ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr)
 23:       call ISGetLocalSize(is,n,ierr)
 24:       if (n .ne. 0) then
 25:         SETERRQ(PETSC_COMM_SELF,1,0,ierr)
 26:       endif
 27:       call ISStrideGetInfo(is,start,stride,ierr)
 28:       if (start .ne. 0) then
 29:          SETERRQ(PETSC_COMM_SELF,1,0,ierr)
 30:       endif
 31:       if (stride .ne. 2) then
 32:         SETERRQ(PETSC_COMM_SELF,1,0,ierr)
 33:       endif
 34:       call PetscObjectTypeCompare(is,ISSTRIDE,flag,ierr)
 35:       if (.not. flag) then
 36:         SETERRQ(PETSC_COMM_SELF,1,0,ierr)
 37:       endif
 38:       call ISGetIndices(is,ii,iis,ierr)
 39:       call ISRestoreIndices(is,ii,iis,ierr)
 40:       call ISDestroy(is,ierr)

 42: !     Test ISGetIndices()

 44:       ssize = 10000
 45:       stride = -8
 46:       first = 3
 47:       call ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr)
 48:       call ISGetLocalSize(is,n,ierr)
 49:       call ISGetIndices(is,ii,iis,ierr)
 50:       do 10, i=1,10000
 51:         if (ii(i+iis) .ne. -11 + 3*i) then
 52:           SETERRQ(PETSC_COMM_SELF,1,0,ierr)
 53:         endif
 54:  10   continue
 55:       call ISRestoreIndices(is,ii,iis,ierr)
 56:       call ISDestroy(is,ierr)

 58:       call PetscFinalize(ierr)
 59:       end