Actual source code: ex12f.F90

      1: program main

      3: #include <petsc/finclude/petscvec.h>

      5: use petscvec
      6: implicit none

      8:   PetscErrorCode ierr
      9:   Vec   v,s
     10:   PetscInt,parameter ::      n   = 20
     11:   PetscScalar,parameter ::   sone = 1.0
     12:   PetscBool :: flg
     13:   PetscInt,parameter :: zero = 0, one = 1, two = 2

     15:  call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
     16:   if (ierr /= 0) then
     17:    print*,'PetscInitialize failed'
     18:    stop
     19:   endif

     21:   call PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-n",n,flg,ierr);CHKERRA(ierr)

     23:   ! Create multi-component vector with 2 components
     24:   call VecCreate(PETSC_COMM_WORLD,v,ierr);CHKERRA(ierr)
     25:   call VecSetSizes(v,PETSC_DECIDE,n,ierr);CHKERRA(ierr)
     26:   call VecSetBlockSize(v,two,ierr);CHKERRA(ierr)
     27:   call VecSetFromOptions(v,ierr);CHKERRA(ierr)

     29:   ! Create single-component vector
     30:   call VecCreate(PETSC_COMM_WORLD,s,ierr);CHKERRA(ierr)
     31:   call VecSetSizes(s,PETSC_DECIDE,n/2,ierr);CHKERRA(ierr)
     32:   call VecSetFromOptions(s,ierr);CHKERRA(ierr)

     34:   !Set the vectors to entries to a constant value.
     35:   call VecSet(v,sone,ierr);CHKERRA(ierr)

     37:   !Get the first component from the multi-component vector to the single vector
     38:   call VecStrideGather(v,zero,s,INSERT_VALUES,ierr);CHKERRA(ierr)

     40:   call VecView(s,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)

     42:   !Put the values back into the second component
     43:   call VecStrideScatter(s,one,v,ADD_VALUES,ierr);CHKERRA(ierr)

     45:   call VecView(v,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)

     47:   ! Free work space.All PETSc objects should be destroyed when they are no longer needed.
     48:   call VecDestroy(v,ierr);CHKERRA(ierr)
     49:   call VecDestroy(s,ierr);CHKERRA(ierr)
     50:   call PetscFinalize(ierr);CHKERRA(ierr)

     52:   end program

     54: !/*TEST
     55: !
     56: !     test:
     57: !       nsize: 2
     58: !       output_file: output/ex12_1.out
     59: !
     60: !TEST*/