Actual source code: ex2f.F90

petsc-3.12.1 2019-10-22
Report Typos and Errors
  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,ii(1),start
 11:       PetscInt  stride,ssize,first
 12:       IS          is
 13:       PetscBool   flag
 14:       PetscOffset iis

 16:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 17:       if (ierr .ne. 0) then
 18:         print*,'Unable to initialize PETSc'
 19:         stop
 20:       endif
 21: 
 22: !     Test IS of size 0
 23:       ssize = 0
 24:       stride = 0
 25:       first = 2
 26:       call ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr)
 27:       call ISGetLocalSize(is,n,ierr)
 28:       if (n .ne. 0) then; SETERRA(PETSC_COMM_SELF,1,'Wrong result from ISCreateStride'); endif

 30:       call ISStrideGetInfo(is,start,stride,ierr)
 31:       if (start .ne. 0) then; SETERRA(PETSC_COMM_SELF,1,'Wrong result from ISStrideGetInfo'); endif

 33:       if (stride .ne. 2) then; SETERRA(PETSC_COMM_SELF,1,'Wrong result from ISStrideGetInfo') ; endif

 35:       call PetscObjectTypeCompare(is,ISSTRIDE,flag,ierr)
 36:       if (.not. flag) then; SETERRA(PETSC_COMM_SELF,1,'Wrong result from PetscObjectTypeCompare'); endif
 37:       call ISGetIndices(is,ii,iis,ierr)
 38:       call ISRestoreIndices(is,ii,iis,ierr)
 39:       call ISDestroy(is,ierr)

 41: !     Test ISGetIndices()

 43:       ssize = 10000
 44:       stride = -8
 45:       first = 3
 46:       call ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr)
 47:       call ISGetLocalSize(is,n,ierr)
 48:       call ISGetIndices(is,ii,iis,ierr)
 49:       do 10, i=1,n
 50:         if (ii(i+iis) .ne. -11 + 3*i) then; SETERRA(PETSC_COMM_SELF,1,'Wrong result from ISGetIndices'); endif
 51:  10   continue
 52:       call ISRestoreIndices(is,ii,iis,ierr)
 53:       call ISDestroy(is,ierr)

 55:       call PetscFinalize(ierr)
 56:       end

 58: !/*TEST
 59: !
 60: !   test:
 61: !     output_file: output/ex1_1.out
 62: !
 63: !TEST*/