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

Actual source code: ex43f.F90

      1:     module ex43fmodule
      2: #include <petsc/finclude/petscvec.h>
      3:       use,intrinsic :: iso_c_binding
      4:       interface
      5:         subroutine fillupvector(vaddr,err) bind ( C, name = 'fillupvector')
      6: !
      7: !     We need to use iso_c_binding variables or otherwise we get compiler warnings
      8: !     Warning: Variable 'vaddr' at (1) is a dummy argument of the BIND(C)
      9: !              procedure 'fillupvector' but may not be C interoperable
     10: !
     11:           use,intrinsic :: iso_c_binding
     12:           integer(c_long_long) vaddr
     13:           integer(c_int) err
     14:         end subroutine fillupvector
     15:       end interface
     16:     end module

     18: #include <petsc/finclude/petscvec.h>
     19:         use,intrinsic :: iso_c_binding
     20:         use petscvec
     21:         use ex43fmodule
     22:        implicit none
     23: !
     24: !  This routine demonstrates how to call a bind C function from Fortran
     25:        Vec            v
     26:        PetscErrorCode ierr
     27:        PetscInt five
     28: !
     29: !     We need to use the same iso_c_binding variable types here or some compilers
     30: !     will see a type mismatch in the call to fillupvector and thus not link
     31: !
     32:        integer(c_long_long) vaddr
     33:        integer(c_int) err

     35:        PetscCallA(PetscInitialize(ierr))
     36:        PetscCallA(VecCreate(PETSC_COMM_WORLD,v,ierr))
     37:        five = 5
     38:        PetscCallA(VecSetSizes(v,PETSC_DECIDE,five,ierr))
     39:        PetscCallA(VecSetFromOptions(v,ierr))
     40: !
     41: !     Now Call a Petsc Routine from Fortran
     42: !
     43: !
     44:        vaddr = v%v
     45:        call fillupvector(vaddr,err)

     47:        PetscCallA(VecView(v,PETSC_VIEWER_STDOUT_WORLD,ierr))
     48:        PetscCallA(VecDestroy(v,ierr))
     49:        PetscCallA(PetscFinalize(ierr))
     50:        end

     52: !/*TEST
     53: !
     54: !   build:
     55: !     depends: ex43.c
     56: !
     57: !   test:
     58: !
     59: !TEST*/