Actual source code: ex1f.F

  1: !
  2: !  Description: Creates an index set based on a set of integers. Views that index set
  3: !  and then destroys it.
  4: !
  5: !
  6: !
  7:       program main
  8: #include <petsc/finclude/petscis.h>
  9:       use petscis
 10:       implicit none

 12:       PetscErrorCode ierr
 13:       PetscInt indices(5),n,index1,index5
 14:       PetscMPIInt rank
 15:       PetscOffset ix
 16:       IS          is

 18:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 19:       if (ierr .ne. 0) then
 20:         print*,'Unable to initialize PETSc'
 21:         stop
 22:       endif
 23:       call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)

 25: !  Create an index set with 5 entries. Each processor creates
 26: !  its own index set with its own list of integers.

 28:       indices(1) = rank + 1
 29:       indices(2) = rank + 2
 30:       indices(3) = rank + 3
 31:       indices(4) = rank + 4
 32:       indices(5) = rank + 5

 34: !     if using 64bit integers cannot pass 5 into routine expecting an integer*8
 35:       n = 5
 36:       call ISCreateGeneral(PETSC_COMM_SELF,n,indices,PETSC_COPY_VALUES,       &
 37:      &                     is,ierr)

 39: !  Print the index set to stdout

 41:       call ISView(is,PETSC_VIEWER_STDOUT_SELF,ierr)

 43: !  Get the number of indices in the set

 45:       call ISGetLocalSize(is,n,ierr)

 47: !   Get the indices in the index set

 49:       call ISGetIndices(is,indices,ix,ierr)

 51: !   Now any code that needs access to the list of integers
 52: !   has access to it here

 54: !
 55: !      Bug in IRIX64-F90 libraries - write/format cannot handle integer(integer*8 + integer)
 56: !

 58:       index1 = indices(ix+1)
 59:       index5 = indices(ix+5)
 60:       write(6,100) rank,index1,index5
 61:  100  format('[',i5,'] First index = ',i5,' fifth index = ',i5)

 63: !   Once we no longer need access to the indices they should
 64: !   returned to the system

 66:       call ISRestoreIndices(is,indices,ix,ierr)

 68: !   All PETSc objects should be destroyed once they are
 69: !   no longer needed

 71:       call ISDestroy(is,ierr)
 72:       call PetscFinalize(ierr)
 73:       end

 75: !/*TEST
 76: !
 77: !   test:
 78: !      filter: sort -b
 79: !      filter_output: sort -b
 80: !
 81: !TEST*/