Date: 2022-08-02T03:13:37+00:00

Actual source code: ex1f.F90

      1: !
      2: !
      3: !
      4: ! -----------------------------------------------------------------------

      6:       program main
      7: #include <petsc/finclude/petscvec.h>
      8:       use petscvec
      9:       implicit none

     11: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     12: !                   Variable declarations
     13: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     14: !
     15: !  Variables:
     16: !     x, y, w - vectors
     17: !     z       - array of vectors

     19:       Vec               :: x,y,w
     20:       Vec, dimension(5) :: z
     21:       PetscReal         :: norm,v,v1,v2
     22:       PetscInt, parameter :: &
     23:         ithree = 3, &
     24:         n = 20
     25:       PetscBool         :: flg
     26:       PetscErrorCode    :: ierr
     27:       PetscMPIInt       :: rank
     28:       PetscScalar, parameter :: &
     29:         one = 1.0, &
     30:         two = 2.0, &
     31:         three = 3.0
     32:       PetscScalar :: dot
     33:       PetscScalar, dimension(3) :: dots
     34:       character(len=PETSC_MAX_PATH_LEN) ::  name
     35:       PetscReal    :: nfloat

     37: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     38: !                 Beginning of program
     39: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     41:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
     42:       if (ierr /= 0) then
     43:         print*,'Unable to initialize PETSc'
     44:         stop
     45:       endif
     46:       call PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr)
     47:       nfloat = n
     48:       call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)

     50: !  Create a vector, specifying only its global dimension.
     51: !  When using VecCreate(), VecSetSizes() and VecSetFromOptions(),
     52: !  the vector format (currently parallel
     53: !  or sequential) is determined at runtime.  Also, the parallel
     54: !  partitioning of the vector is determined by PETSc at runtime.
     55: !
     56: !  Routines for creating particular vector types directly are:
     57: !     VecCreateSeq() - uniprocessor vector
     58: !     VecCreateMPI() - distributed vector, where the user can
     59: !                      determine the parallel partitioning
     60: !     VecCreateShared() - parallel vector that uses shared memory
     61: !                         (available only on the SGI); otherwise,
     62: !                         is the same as VecCreateMPI()
     63: !
     64: !     VecCreate(), VecSetSizes() and VecSetFromOptions() allows one
     65: !                 to determine at runtime which version to use
     66: !                 with the options -vec_type mpi or -vec_type shared
     67: !
     68:       call VecCreate(PETSC_COMM_WORLD,x,ierr)
     69:       call VecSetSizes(x,PETSC_DECIDE,n,ierr)
     70:       call VecSetFromOptions(x,ierr)
     71:       call VecGetType(x,name,ierr)

     73: !  Duplicate some work vectors (of the same format and
     74: !  partitioning as the initial vector).

     76:       call VecDuplicate(x,y,ierr)
     77:       call VecDuplicate(x,w,ierr)

     79: !  Duplicate more work vectors (of the same format and
     80: !  partitioning as the initial vector).  Here we duplicate
     81: !  an array of vectors, which is often more convenient than
     82: !  duplicating individual ones.

     84:       call VecDuplicateVecs(x,ithree,z,ierr)

     86: !  Set the vectors to entries to a constant value.

     88:       call VecSet(x,one,ierr)

     90:       call VecSet(y,two,ierr)
     91:       call VecSet(z(1),one,ierr)
     92:       call VecSet(z(2),two,ierr)
     93:       call VecSet(z(3),three,ierr)

     95: !  Demonstrate various basic vector routines.

     97:       call VecDot(x,x,dot,ierr)
     98:       call VecMDot(x,ithree,z,dots,ierr)

    100: !  Note: If using a complex numbers version of PETSc, then
    101: !  PETSC_USE_COMPLEX is defined in the makefiles; otherwise,
    102: !  (when using real numbers) it is undefined.

    104:       if (rank .eq. 0) then
    105: #if defined(PETSC_USE_COMPLEX)
    106:          write(6,100) int(PetscRealPart(dot))
    107:          write(6,110) int(PetscRealPart(dots(1))),int(PetscRealPart(dots(2))),int(PetscRealPart(dots(3)))
    108: #else
    109:          write(6,100) int(dot)
    110:          write(6,110) int(dots(1)),int(dots(2)),int(dots(3))
    111: #endif
    112:          write(6,120)
    113:       endif
    114:  100  format ('Vector length ',i6)
    115:  110  format ('Vector length ',3(i6))
    116:  120  format ('All other values should be near zero')

    118:       call VecScale(x,two,ierr)
    119:       call VecNorm(x,NORM_2,norm,ierr)
    120:       v = abs(norm-2.0*sqrt(nfloat))
    121:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
    122:       if (rank == 0) write(6,130) v
    123:  130  format ('VecScale ',1pe9.2)

    125:       call VecCopy(x,w,ierr)
    126:       call VecNorm(w,NORM_2,norm,ierr)
    127:       v = abs(norm-2.0*sqrt(nfloat))
    128:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
    129:       if (rank == 0) write(6,140) v
    130:  140  format ('VecCopy ',1pe9.2)

    132:       call VecAXPY(y,three,x,ierr)
    133:       call VecNorm(y,NORM_2,norm,ierr)
    134:       v = abs(norm-8.0*sqrt(nfloat))
    135:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
    136:       if (rank == 0) write(6,150) v
    137:  150  format ('VecAXPY ',1pe9.2)

    139:       call VecAYPX(y,two,x,ierr)
    140:       call VecNorm(y,NORM_2,norm,ierr)
    141:       v = abs(norm-18.0*sqrt(nfloat))
    142:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
    143:       if (rank == 0) write(6,160) v
    144:  160  format ('VecAYXP ',1pe9.2)

    146:       call VecSwap(x,y,ierr)
    147:       call VecNorm(y,NORM_2,norm,ierr)
    148:       v = abs(norm-2.0*sqrt(nfloat))
    149:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
    150:       if (rank == 0) write(6,170) v
    151:  170  format ('VecSwap ',1pe9.2)

    153:       call VecNorm(x,NORM_2,norm,ierr)
    154:       v = abs(norm-18.0*sqrt(nfloat))
    155:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
    156:       if (rank == 0) write(6,180) v
    157:  180  format ('VecSwap ',1pe9.2)

    159:       call VecWAXPY(w,two,x,y,ierr)
    160:       call VecNorm(w,NORM_2,norm,ierr)
    161:       v = abs(norm-38.0*sqrt(nfloat))
    162:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
    163:       if (rank == 0) write(6,190) v
    164:  190  format ('VecWAXPY ',1pe9.2)

    166:       call VecPointwiseMult(w,y,x,ierr)
    167:       call VecNorm(w,NORM_2,norm,ierr)
    168:       v = abs(norm-36.0*sqrt(nfloat))
    169:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
    170:       if (rank == 0) write(6,200) v
    171:  200  format ('VecPointwiseMult ',1pe9.2)

    173:       call VecPointwiseDivide(w,x,y,ierr)
    174:       call VecNorm(w,NORM_2,norm,ierr)
    175:       v = abs(norm-9.0*sqrt(nfloat))
    176:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
    177:       if (rank == 0) write(6,210) v
    178:  210  format ('VecPointwiseDivide ',1pe9.2)

    180:       dots(1) = one
    181:       dots(2) = three
    182:       dots(3) = two
    183:       call VecSet(x,one,ierr)
    184:       call VecMAXPY(x,ithree,dots,z,ierr)
    185:       call VecNorm(z(1),NORM_2,norm,ierr)
    186:       v = abs(norm-sqrt(nfloat))
    187:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
    188:       call VecNorm(z(2),NORM_2,norm,ierr)
    189:       v1 = abs(norm-2.0*sqrt(nfloat))
    190:       if (v1 .gt. -PETSC_SMALL .and. v1 .lt. PETSC_SMALL) v1 = 0.0
    191:       call VecNorm(z(3),NORM_2,norm,ierr)
    192:       v2 = abs(norm-3.0*sqrt(nfloat))
    193:       if (v2 .gt. -PETSC_SMALL .and. v2 .lt. PETSC_SMALL) v2 = 0.0
    194:       if (rank .eq. 0) write(6,220) v,v1,v2
    195:  220  format ('VecMAXPY ',3(2x,1pe9.2))

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

    200:       call VecDestroy(x,ierr)
    201:       call VecDestroy(y,ierr)
    202:       call VecDestroy(w,ierr)
    203:       call VecDestroyVecs(ithree,z,ierr)
    204:       call PetscFinalize(ierr)

    206:       end

    208: !
    209: !/*TEST
    210: !
    211: !     test:
    212: !       suffix: 1
    213: !
    214: !     test:
    215: !       suffix: 2
    216: !       nsize: 2
    217: !
    218: !TEST*/