Date: 2022-03-31T04:46:30+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: !/*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*/