Actual source code: ex32f.F

petsc-3.12.0 2019-09-29
Report Typos and Errors
  1: !
  2: !
  3: !  Tests PescOffsetFortran()
  4: !  duplicated
  5:       program main
  6:  #include <petsc/finclude/petscvec.h>
  7:       use petscvec
  8:        implicit none

 10:       PetscErrorCode ierr
 11:       PetscInt  n
 12:       PetscMPIInt size

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

 19:       n=8
 20:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 21:       if (ierr .ne. 0) then
 22:         print*,'Unable to initialize PETSc'
 23:         stop
 24:       endif
 25:       call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
 26:       if (size .gt. 1) then
 27:         print*,'Example for one processor only'
 28:         call MPI_Abort(MPI_COMM_WORLD,0,ierr)
 29:       endif

 31:       call VecCreateMPI(PETSC_COMM_WORLD,PETSC_DECIDE,n,v,ierr)
 32:       call VecGetArray(v,v_v1,i_v1,ierr)

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

 39:       call VecView(v,PETSC_VIEWER_STDOUT_WORLD,ierr)

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

 49:       call VecDestroy(v,ierr)
 50:       call PetscFinalize(ierr)

 52:       end

 54: !/*TEST
 55: !
 56: !     test:
 57: !       requires: !complex
 58: !
 59: !TEST*/