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*/