Date: 2026-03-01T05:25:22+00:00

Actual source code: ex3f90.F90

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

     10:   PetscErrorCode ierr
     11:   PetscInt n, bs, issize
     12:   PetscInt inputindices(4)
     13:   PetscInt, pointer :: indices(:)
     14:   IS set
     15:   PetscBool isablock

     17:   n = 4
     18:   bs = 3
     19:   inputindices(1) = 0
     20:   inputindices(2) = 1
     21:   inputindices(3) = 3
     22:   inputindices(4) = 4

     24:   PetscCallA(PetscInitialize(ierr))
     25: !
     26: !    Create a block index set. The index set has 4 blocks each of size 3.
     27: !    The indices are {0,1,2,3,4,5,9,10,11,12,13,14}
     28: !    Note each processor is generating its own index set
     29: !    (in this case they are all identical)
     30: !
     31:   PetscCallA(ISCreateBlock(PETSC_COMM_SELF, bs, n, inputindices, PETSC_COPY_VALUES, set, ierr))
     32:   PetscCallA(ISView(set, PETSC_VIEWER_STDOUT_SELF, ierr))

     34: !
     35: !    Extract indices from set.
     36: !
     37:   PetscCallA(ISGetLocalSize(set, issize, ierr))
     38:   PetscCallA(ISGetIndices(set, indices, ierr))
     39:   write (6, 100) indices
     40: 100 format(12I3)
     41:   PetscCallA(ISRestoreIndices(set, indices, ierr))

     43: !
     44: !    Extract the block indices. This returns one index per block.
     45: !
     46:   PetscCallA(ISBlockGetIndices(set, indices, ierr))
     47:   write (6, 200) indices
     48: 200 format(4I3)
     49:   PetscCallA(ISBlockRestoreIndices(set, indices, ierr))

     51: !
     52: !    Check if this is really a block index set
     53: !
     54:   PetscCallA(PetscObjectTypeCompare(PetscObjectCast(set), ISBLOCK, isablock, ierr))
     55:   if (.not. isablock) then
     56:     write (6, *) 'Index set is not blocked!'
     57:   end if

     59: !
     60: !    Determine the block size of the index set
     61: !
     62:   PetscCallA(ISGetBlockSize(set, bs, ierr))
     63:   if (bs /= 3) then
     64:     write (6, *) 'Blocksize != 3'
     65:   end if

     67: !
     68: !    Get the number of blocks
     69: !
     70:   PetscCallA(ISBlockGetLocalSize(set, n, ierr))
     71:   if (n /= 4) then
     72:     write (6, *) 'Number of blocks != 4'
     73:   end if

     75:   PetscCallA(ISDestroy(set, ierr))
     76:   PetscCallA(PetscFinalize(ierr))
     77: end

     79: !/*TEST
     80: !
     81: !   test:
     82: !      filter: sort -b
     83: !      filter_output: sort -b
     84: !
     85: !TEST*/