Actual source code: ex32f.F90

  1: !
  2: !
  3: !  Tests PescOffsetFortran()
  4: !  duplicated
  5:       program main
  6: #include <petsc/finclude/petscvec.h>
  7:       use petscmpi  ! or mpi or mpi_f08
  8:       use petscvec
  9:        implicit none

 11:       PetscErrorCode ierr
 12:       PetscInt  n
 13:       PetscMPIInt size,zero

 15:       PetscScalar  v_v1(1),v_v2(1)
 16:       Vec     v
 17:       PetscInt i
 18:       PetscOffset i_v1,i_v2

 20:       zero=0
 21:       n=8
 22:       PetscCallA(PetscInitialize(ierr))
 23:       PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD,size,ierr))
 24:       if (size .gt. 1) then
 25:         print*,'Example for one processor only'
 26:         PetscCallMPIA(MPI_Abort(MPI_COMM_WORLD,zero,ierr))
 27:       endif

 29:       PetscCallA(VecCreateMPI(PETSC_COMM_WORLD,PETSC_DECIDE,n,v,ierr))
 30:       PetscCallA(VecGetArray(v,v_v1,i_v1,ierr))

 32:       do 10, i=1,n
 33:         v_v1(i_v1 + i) = i
 34:  10   continue
 35:       PetscCallA(VecRestoreArray(v,v_v1,i_v1,ierr))

 37:       PetscCallA(VecView(v,PETSC_VIEWER_STDOUT_WORLD,ierr))

 39:       PetscCallA(VecGetArray(v,v_v1,i_v1,ierr))
 40:       PetscCallA(PetscOffsetFortran(v_v2,v_v1,i_v2,ierr))
 41:       i_v2 = i_v1 + i_v2
 42:       do 20, i=1,n
 43:         print*,i,v_v2(i_v2 + i)
 44:  20   continue
 45:       PetscCallA(VecRestoreArray(v,v_v1,i_v1,ierr))

 47:       PetscCallA(VecDestroy(v,ierr))
 48:       PetscCallA(PetscFinalize(ierr))

 50:       end

 52: !/*TEST
 53: !
 54: !     test:
 55: !       requires: !complex
 56: !
 57: !TEST*/