Actual source code: ex21f90.F90
1: !
2: !
3: ! Demonstrates how one may access entries of a PETSc Vec as if it was an array of Fortran derived types
4: !
5: !/*T
6: ! Concepts: vectors^basic routines;
7: ! Processors: n
8: !T*/
9: !
10: ! -----------------------------------------------------------------------
12: module mymoduleex21f90
13: #include <petsc/finclude/petscsys.h>
14: type MyStruct
15: sequence
16: PetscScalar :: a,b,c
17: end type MyStruct
18: end module
20: !
21: ! These routines are used internally by the C functions VecGetArrayMyStruct() and VecRestoreArrayMyStruct()
22: ! Because Fortran requires "knowing" exactly what derived types the pointers to point too, these have to be
23: ! customized for exactly the derived type in question
24: !
25: subroutine F90Array1dCreateMyStruct(array,start,len,ptr)
26: #include <petsc/finclude/petscsys.h>
27: use petscsys
28: use mymoduleex21f90
29: implicit none
30: PetscInt start,len
31: type(MyStruct), target :: array(start:start+len-1)
32: type(MyStruct), pointer :: ptr(:)
34: ptr => array
35: end subroutine
37: subroutine F90Array1dAccessMyStruct(ptr,address)
38: #include <petsc/finclude/petscsys.h>
39: use petscsys
40: use mymoduleex21f90
41: implicit none
42: type(MyStruct), pointer :: ptr(:)
43: PetscFortranAddr address
44: PetscInt start
46: start = lbound(ptr,1)
47: call F90Array1dGetAddrMyStruct(ptr(start),address)
48: end subroutine
50: subroutine F90Array1dDestroyMyStruct(ptr)
51: #include <petsc/finclude/petscsys.h>
52: use petscsys
53: use mymoduleex21f90
54: implicit none
55: type(MyStruct), pointer :: ptr(:)
57: nullify(ptr)
58: end subroutine
60: program main
61: #include <petsc/finclude/petscvec.h>
62: use petscvec
63: use mymoduleex21f90
64: implicit none
66: !
67: !
68: ! These two routines are defined in ex21.c they create the Fortran pointer to the derived type
69: !
70: Interface
71: Subroutine VecGetArrayMyStruct(v,array,ierr)
72: use petscvec
73: use mymoduleex21f90
74: type(MyStruct), pointer :: array(:)
75: PetscErrorCode ierr
76: Vec v
77: End Subroutine
78: End Interface
80: Interface
81: Subroutine VecRestoreArrayMyStruct(v,array,ierr)
82: use petscvec
83: use mymoduleex21f90
84: type(MyStruct), pointer :: array(:)
85: PetscErrorCode ierr
86: Vec v
87: End Subroutine
88: End Interface
90: !
91: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
92: ! Variable declarations
93: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
94: !
95: ! Variables:
96: ! x, y, w - vectors
97: ! z - array of vectors
98: !
99: Vec x,y
100: type(MyStruct), pointer :: xarray(:)
101: PetscInt n
102: PetscErrorCode ierr
103: PetscBool flg
104: integer i
106: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
107: ! Beginning of program
108: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
110: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
111: if (ierr .ne. 0) then
112: print*,'PetscInitialize failed'
113: stop
114: endif
115: n = 30
117: call PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr);CHKERRA(ierr)
118: call VecCreate(PETSC_COMM_WORLD,x,ierr);CHKERRA(ierr)
119: call VecSetSizes(x,PETSC_DECIDE,n,ierr);CHKERRA(ierr)
120: call VecSetFromOptions(x,ierr);CHKERRA(ierr)
121: call VecDuplicate(x,y,ierr);CHKERRA(ierr)
123: call VecGetArrayMyStruct(x,xarray,ierr);CHKERRA(ierr)
124: do i=1,10
125: xarray(i)%a = i
126: xarray(i)%b = 100*i
127: xarray(i)%c = 10000*i
128: enddo
130: call VecRestoreArrayMyStruct(x,xarray,ierr);CHKERRA(ierr)
131: call VecView(x,PETSC_VIEWER_STDOUT_SELF,ierr);CHKERRA(ierr)
132: call VecGetArrayMyStruct(x,xarray,ierr);CHKERRA(ierr)
133: do i = 1 , 10
134: write(*,*) abs(xarray(i)%a),abs(xarray(i)%b),abs(xarray(i)%c)
135: end do
136: call VecRestoreArrayMyStruct(x,xarray,ierr);CHKERRA(ierr)
138: call VecDestroy(x,ierr);CHKERRA(ierr)
139: call VecDestroy(y,ierr);CHKERRA(ierr)
140: call PetscFinalize(ierr)
142: end
144: !/*TEST
145: ! build:
146: ! depends: ex21.c
147: !
148: ! test:
149: !
150: !TEST*/