Actual source code: ex32f.F

petsc-3.15.0 2021-03-30
Report Typos and Errors
  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:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 23:       if (ierr .ne. 0) then
 24:         print*,'Unable to initialize PETSc'
 25:         stop
 26:       endif
 27:       call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
 28:       if (size .gt. 1) then
 29:         print*,'Example for one processor only'
 30:         call MPI_Abort(MPI_COMM_WORLD,zero,ierr)
 31:       endif

 33:       call VecCreateMPI(PETSC_COMM_WORLD,PETSC_DECIDE,n,v,ierr)
 34:       call VecGetArray(v,v_v1,i_v1,ierr)

 36:       do 10, i=1,n
 37:         v_v1(i_v1 + i) = i
 38:  10   continue
 39:       call VecRestoreArray(v,v_v1,i_v1,ierr)

 41:       call VecView(v,PETSC_VIEWER_STDOUT_WORLD,ierr)

 43:       call VecGetArray(v,v_v1,i_v1,ierr)
 44:       call PetscOffsetFortran(v_v2,v_v1,i_v2,ierr)
 45:       i_v2 = i_v1 + i_v2
 46:       do 20, i=1,n
 47:         print*,i,v_v2(i_v2 + i)
 48:  20   continue
 49:       call VecRestoreArray(v,v_v1,i_v1,ierr)

 51:       call VecDestroy(v,ierr)
 52:       call PetscFinalize(ierr)

 54:       end

 56: !/*TEST
 57: !
 58: !     test:
 59: !       requires: !complex
 60: !
 61: !TEST*/