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: !
  6: ! -----------------------------------------------------------------------

  8: module ex21f90module
  9: #include <petsc/finclude/petscsys.h>
 10:   use petscsys
 11:   type MyStruct
 12:     sequence
 13:     PetscScalar :: a, b, c
 14:   end type MyStruct
 15: end module

 17: !
 18: !  These routines are used internally by the C functions VecGetArrayMyStruct() and VecRestoreArrayMyStruct()
 19: !  Because Fortran requires "knowing" exactly what derived types the pointers to point too, these have to be
 20: !  customized for exactly the derived type in question
 21: !
 22: subroutine F90Array1dCreateMyStruct(array, start, len, ptr)
 23:   use ex21f90module
 24:   implicit none
 25:   PetscInt start, len
 26:   type(MyStruct), target :: array(start:start + len - 1)
 27:   type(MyStruct), pointer :: ptr(:)

 29:   ptr => array
 30: end subroutine

 32: subroutine F90Array1dAccessMyStruct(ptr, address)
 33:   use ex21f90module
 34:   implicit none
 35:   type(MyStruct), pointer :: ptr(:)
 36:   PetscFortranAddr address
 37:   PetscInt start

 39:   start = lbound(ptr, 1)
 40:   call F90Array1dGetAddrMyStruct(ptr(start), address)
 41: end subroutine

 43: subroutine F90Array1dDestroyMyStruct(ptr)
 44:   use ex21f90module
 45:   implicit none
 46:   type(MyStruct), pointer :: ptr(:)

 48:   nullify (ptr)
 49: end subroutine

 51: program main
 52: #include <petsc/finclude/petscvec.h>
 53:   use petscvec
 54:   use ex21f90module
 55:   implicit none

 57: !
 58: !
 59: !   These two routines are defined in ex21.c they create the Fortran pointer to the derived type
 60: !
 61:   Interface
 62:     Subroutine VecGetArrayMyStruct(v, array, ierr)
 63: #include <petsc/finclude/petscvec.h>
 64:       use petscvec
 65:       use ex21f90module
 66:       type(MyStruct), pointer :: array(:)
 67:       PetscErrorCode ierr
 68:       Vec v
 69:     End Subroutine
 70:   End Interface

 72:   Interface
 73:     Subroutine VecRestoreArrayMyStruct(v, array, ierr)
 74: #include <petsc/finclude/petscvec.h>
 75:       use petscvec
 76:       use ex21f90module
 77:       type(MyStruct), pointer :: array(:)
 78:       PetscErrorCode ierr
 79:       Vec v
 80:     End Subroutine
 81:   End Interface

 83: !
 84: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 85: !                   Variable declarations
 86: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 87: !
 88: !  Variables:
 89: !     x, y, w - vectors
 90: !     z       - array of vectors
 91: !
 92:   Vec x, y
 93:   type(MyStruct), pointer :: xarray(:)
 94:   PetscInt n
 95:   PetscErrorCode ierr
 96:   PetscBool flg
 97:   integer i

 99: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
100: !                 Beginning of program
101: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

103:   PetscCallA(PetscInitialize(ierr))
104:   n = 30

106:   PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr))
107:   PetscCallA(VecCreate(PETSC_COMM_WORLD, x, ierr))
108:   PetscCallA(VecSetSizes(x, PETSC_DECIDE, n, ierr))
109:   PetscCallA(VecSetFromOptions(x, ierr))
110:   PetscCallA(VecDuplicate(x, y, ierr))

112:   PetscCallA(VecGetArrayMyStruct(x, xarray, ierr))
113:   do i = 1, 10
114:     xarray(i)%a = i
115:     xarray(i)%b = 100*i
116:     xarray(i)%c = 10000*i
117:   end do

119:   PetscCallA(VecRestoreArrayMyStruct(x, xarray, ierr))
120:   PetscCallA(VecView(x, PETSC_VIEWER_STDOUT_SELF, ierr))
121:   PetscCallA(VecGetArrayMyStruct(x, xarray, ierr))
122:   do i = 1, 10
123:     write (*, *) abs(xarray(i)%a), abs(xarray(i)%b), abs(xarray(i)%c)
124:   end do
125:   PetscCallA(VecRestoreArrayMyStruct(x, xarray, ierr))

127:   PetscCallA(VecDestroy(x, ierr))
128:   PetscCallA(VecDestroy(y, ierr))
129:   PetscCallA(PetscFinalize(ierr))

131: end

133: !/*TEST
134: !   build:
135: !     depends: ex21.c
136: !
137: !   test:
138: !
139: !TEST*/