Actual source code: ex1f90.F
1: !
2: ! "$Id: ex1f90.F,v 1.18 2001/01/15 21:44:33 bsmith Exp $";
3: !
4: ! Description: Creates an index set based on a set of integers. Views that index set
5: ! and then destroys it.
6: !
7: !/*T
8: ! Concepts: index sets^manipulating a general index set;
9: ! Concepts: Fortran90^accessing indices of index set;
10: !T*/
11: !
12: ! The following include statements are required for Fortran programs
13: ! that use PETSc index sets:
14: ! petsc.h - base PETSc routines
15: ! petscis.h - index sets (IS objects)
16: ! petscis.h90 - to allow access to Fortran90 features of index sets
17: !
18: program main
19: implicit none
21: #include finclude/petsc.h
22: #include finclude/petscis.h
23: #include "finclude/petscis.h90"
25: integer ierr,indices(5),rank,n
26: integer, pointer :: idx(:)
27: IS is
29: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
30: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
32: ! Create an index set with 5 entries. Each processor creates
33: ! its own index set with its own list of integers.
34:
35: indices(1) = rank + 1
36: indices(2) = rank + 2
37: indices(3) = rank + 3
38: indices(4) = rank + 4
39: indices(5) = rank + 5
40: call ISCreateGeneral(PETSC_COMM_SELF,5,indices,is,ierr)
42: ! Print the index set to stdout
44: call ISView(is,PETSC_VIEWER_STDOUT_SELF,ierr)
46: ! Get the number of indices in the set
48: call ISGetLocalSize(is,n,ierr)
50: ! Get the indices in the index set
52: call ISGetIndicesF90(is,idx,ierr)
54: if (associated(idx)) then
55: write (*,*) 'Association check passed'
56: else
57: write (*,*) 'Association check failed'
58: endif
60: ! Now any code that needs access to the list of integers
61: ! has access to it here
63: write(6,50) idx
64: 50 format(5I3)
66: write(6,100) rank,idx(1),idx(5)
67: 100 format('[',i5,'] First index = ',i5,' fifth index = ',i5)
68:
69: ! Once we no longer need access to the indices they should
70: ! returned to the system
72: call ISRestoreIndicesF90(is,idx,ierr)
73:
74: ! All PETSc objects should be destroyed once they are
75: ! no longer needed
77: call ISDestroy(is,ierr)
78: call PetscFinalize(ierr)
79: end
81: