Actual source code: ex32f.F
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*/