Date: 2025-03-29T05:58:55+00:00

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:       type MyStruct
     11:         sequence
     12:         PetscScalar :: a,b,c
     13:       end type MyStruct
     14:       end module

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

     30:       ptr => array
     31:       end subroutine

     33:       subroutine F90Array1dAccessMyStruct(ptr,address)
     34: #include <petsc/finclude/petscsys.h>
     35:       use petscsys
     36:       use ex21f90module
     37:       implicit none
     38:       type(MyStruct), pointer :: ptr(:)
     39:       PetscFortranAddr address
     40:       PetscInt start

     42:       start = lbound(ptr,1)
     43:       call F90Array1dGetAddrMyStruct(ptr(start),address)
     44:       end subroutine

     46:       subroutine F90Array1dDestroyMyStruct(ptr)
     47: #include <petsc/finclude/petscsys.h>
     48:       use petscsys
     49:       use ex21f90module
     50:       implicit none
     51:       type(MyStruct), pointer :: ptr(:)

     53:       nullify(ptr)
     54:       end subroutine

     56:       program main
     57: #include <petsc/finclude/petscvec.h>
     58:       use petscvec
     59:       use ex21f90module
     60:       implicit none

     62: !
     63: !
     64: !   These two routines are defined in ex21.c they create the Fortran pointer to the derived type
     65: !
     66:       Interface
     67:         Subroutine VecGetArrayMyStruct(v,array,ierr)
     68:           use petscvec
     69:           use ex21f90module
     70:           type(MyStruct), pointer :: array(:)
     71:           PetscErrorCode ierr
     72:           Vec     v
     73:         End Subroutine
     74:       End Interface

     76:       Interface
     77:         Subroutine VecRestoreArrayMyStruct(v,array,ierr)
     78:           use petscvec
     79:           use ex21f90module
     80:           type(MyStruct), pointer :: array(:)
     81:           PetscErrorCode ierr
     82:           Vec     v
     83:         End Subroutine
     84:       End Interface

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

    102: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    103: !                 Beginning of program
    104: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    106:       PetscCallA(PetscInitialize(ierr))
    107:       n     = 30

    109:       PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr))
    110:       PetscCallA(VecCreate(PETSC_COMM_WORLD,x,ierr))
    111:       PetscCallA(VecSetSizes(x,PETSC_DECIDE,n,ierr))
    112:       PetscCallA(VecSetFromOptions(x,ierr))
    113:       PetscCallA(VecDuplicate(x,y,ierr))

    115:       PetscCallA(VecGetArrayMyStruct(x,xarray,ierr))
    116:       do i=1,10
    117:       xarray(i)%a = i
    118:       xarray(i)%b = 100*i
    119:       xarray(i)%c = 10000*i
    120:       enddo

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

    130:       PetscCallA(VecDestroy(x,ierr))
    131:       PetscCallA(VecDestroy(y,ierr))
    132:       PetscCallA(PetscFinalize(ierr))

    134:       end

    136: !/*TEST
    137: !   build:
    138: !     depends: ex21.c
    139: !
    140: !   test:
    141: !
    142: !TEST*/