Date: 2021-03-03T22:25:59+00:00

Actual source code: ex4f90.F90
petsc-3.14.5 2021-03-03
Report Typos and Errors

      1: !
      2: !
      3: !  Description:  Illustrates the use of VecSetValues() to set
      4: !  multiple values at once; demonstrates VecGetArrayF90().
      5: !
      6: !/*T
      7: !   Concepts: vectors^assembling vectors;
      8: !   Concepts: vectors^arrays;
      9: !   Concepts: Fortran90^assembling vectors;
     10: !   Processors: 1
     11: !T*/
     12: ! -----------------------------------------------------------------------

     14:       program main
     15: #include <petsc/finclude/petscvec.h>
     16:       use petscvec
     17:       implicit none

     19: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     20: !                 Beginning of program
     21: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     23:        PetscInt, parameter :: n=6
     24:        PetscScalar, dimension(n) ::  xwork
     25:        PetscScalar, pointer, dimension(:) ::  xx_v,yy_v
     26:        PetscInt, dimension(n) :: loc
     27:        PetscInt i
     28:        PetscErrorCode ierr
     29:        Vec     x,y

     32:        call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
     33:        if (ierr /= 0) then
     34:          print*,'PetscInitialize failed'
     35:          stop
     36:        endif

     38: !  Create initial vector and duplicate it

     40:        call VecCreateSeq(PETSC_COMM_SELF,n,x,ierr);CHKERRA(ierr)
     41:        call VecDuplicate(x,y,ierr);CHKERRA(ierr)

     43: !  Fill work arrays with vector entries and locations.  Note that
     44: !  the vector indices are 0-based in PETSc (for both Fortran and
     45: !  C vectors)

     47:        do 10 i=1,n
     48:           loc(i) = i-1
     49:           xwork(i) = 10.0*real(i)
     50:   10   continue

     52: !  Set vector values.  Note that we set multiple entries at once.
     53: !  Of course, usually one would create a work array that is the
     54: !  natural size for a particular problem (not one that is as long
     55: !  as the full vector).

     57:        call VecSetValues(x,n,loc,xwork,INSERT_VALUES,ierr);CHKERRA(ierr)

     59: !  Assemble vector

     61:        call VecAssemblyBegin(x,ierr);CHKERRA(ierr)
     62:        call VecAssemblyEnd(x,ierr);CHKERRA(ierr)

     64: !  View vector
     65:        call PetscObjectSetName(x, 'initial vector:',ierr);CHKERRA(ierr)
     66:        call VecView(x,PETSC_VIEWER_STDOUT_SELF,ierr);CHKERRA(ierr)
     67:        call VecCopy(x,y,ierr);CHKERRA(ierr)

     69: !  Get a pointer to vector data.
     70: !    - For default PETSc vectors, VecGetArrayF90() returns a pointer to
     71: !      the data array.  Otherwise, the routine is implementation dependent.
     72: !    - You MUST call VecRestoreArray() when you no longer need access to
     73: !      the array.

     75:        call VecGetArrayF90(x,xx_v,ierr);CHKERRA(ierr)
     76:        call VecGetArrayF90(y,yy_v,ierr);CHKERRA(ierr)

     78: !  Modify vector data

     80:        do 30 i=1,n
     81:           xx_v(i) = 100.0*real(i)
     82:           yy_v(i) = 1000.0*real(i)
     83:   30   continue

     85: !  Restore vectors

     87:        call VecRestoreArrayF90(x,xx_v,ierr);CHKERRA(ierr)
     88:        call VecRestoreArrayF90(y,yy_v,ierr);CHKERRA(ierr)

     90: !  View vectors
     91:        call PetscObjectSetName(x, 'new vector 1:',ierr);CHKERRA(ierr)
     92:        call VecView(x,PETSC_VIEWER_STDOUT_SELF,ierr);CHKERRA(ierr)

     94:        call PetscObjectSetName(y, 'new vector 2:',ierr);CHKERRA(ierr)
     95:        call VecView(y,PETSC_VIEWER_STDOUT_SELF,ierr);CHKERRA(ierr)

     97: !  Free work space.  All PETSc objects should be destroyed when they
     98: !  are no longer needed.

    100:        call VecDestroy(x,ierr);CHKERRA(ierr)
    101:        call VecDestroy(y,ierr);CHKERRA(ierr)
    102:        call PetscFinalize(ierr)
    103:        end

    105: !
    106: !/*TEST
    107: !
    108: !     test:
    109: !
    110: !TEST*/