Actual source code: ex1f.F90

  1:       program main
  2: #include <petsc/finclude/petscvec.h>
  3:       use petscvec
  4:       implicit none

  6: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  7: !                   Variable declarations
  8: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  9: !
 10: !  Variables:
 11: !     x, y, w - vectors
 12: !     z       - array of vectors

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

 32: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 33: !                 Beginning of program
 34: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 36:       PetscCallA(PetscInitialize(ierr))
 37:       PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr))
 38:       nfloat = n
 39:       PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))

 41: !  Create a vector, specifying only its global dimension.
 42: !  When using VecCreate(), VecSetSizes() and VecSetFromOptions(),
 43: !  the vector format (currently parallel
 44: !  or sequential) is determined at runtime.  Also, the parallel
 45: !  partitioning of the vector is determined by PETSc at runtime.
 46: !
 47:       PetscCallA(VecCreate(PETSC_COMM_WORLD,x,ierr))
 48:       PetscCallA(VecSetSizes(x,PETSC_DECIDE,n,ierr))
 49:       PetscCallA(VecSetFromOptions(x,ierr))
 50:       PetscCallA(VecGetType(x,name,ierr))

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

 55:       PetscCallA(VecDuplicate(x,y,ierr))
 56:       PetscCallA(VecDuplicate(x,w,ierr))

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

 63:       PetscCallA(VecDuplicateVecs(x,ithree,z,ierr))

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

 67:       PetscCallA(VecSet(x,one,ierr))

 69:       PetscCallA(VecSet(y,two,ierr))
 70:       PetscCallA(VecSet(z(1),one,ierr))
 71:       PetscCallA(VecSet(z(2),two,ierr))
 72:       PetscCallA(VecSet(z(3),three,ierr))

 74: !  Demonstrate various basic vector routines.

 76:       PetscCallA(VecDot(x,x,dot,ierr))
 77:       PetscCallA(VecMDot(x,ithree,z,dots,ierr))

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

 83:       if (rank .eq. 0) then
 84: #if defined(PETSC_USE_COMPLEX)
 85:          write(6,100) int(PetscRealPart(dot))
 86:          write(6,110) int(PetscRealPart(dots(1))),int(PetscRealPart(dots(2))),int(PetscRealPart(dots(3)))
 87: #else
 88:          write(6,100) int(dot)
 89:          write(6,110) int(dots(1)),int(dots(2)),int(dots(3))
 90: #endif
 91:          write(6,120)
 92:       endif
 93:  100  format ('Vector length ',i6)
 94:  110  format ('Vector length ',3(i6))
 95:  120  format ('All other values should be near zero')

 97:       PetscCallA(VecScale(x,two,ierr))
 98:       PetscCallA(VecNorm(x,NORM_2,norm,ierr))
 99:       v = abs(norm-2.0*sqrt(nfloat))
100:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
101:       if (rank == 0) write(6,130) v
102:  130  format ('VecScale ',1pe9.2)

104:       PetscCallA(VecCopy(x,w,ierr))
105:       PetscCallA(VecNorm(w,NORM_2,norm,ierr))
106:       v = abs(norm-2.0*sqrt(nfloat))
107:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
108:       if (rank == 0) write(6,140) v
109:  140  format ('VecCopy ',1pe9.2)

111:       PetscCallA(VecAXPY(y,three,x,ierr))
112:       PetscCallA(VecNorm(y,NORM_2,norm,ierr))
113:       v = abs(norm-8.0*sqrt(nfloat))
114:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
115:       if (rank == 0) write(6,150) v
116:  150  format ('VecAXPY ',1pe9.2)

118:       PetscCallA(VecAYPX(y,two,x,ierr))
119:       PetscCallA(VecNorm(y,NORM_2,norm,ierr))
120:       v = abs(norm-18.0*sqrt(nfloat))
121:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
122:       if (rank == 0) write(6,160) v
123:  160  format ('VecAYXP ',1pe9.2)

125:       PetscCallA(VecSwap(x,y,ierr))
126:       PetscCallA(VecNorm(y,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,170) v
130:  170  format ('VecSwap ',1pe9.2)

132:       PetscCallA(VecNorm(x,NORM_2,norm,ierr))
133:       v = abs(norm-18.0*sqrt(nfloat))
134:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
135:       if (rank == 0) write(6,180) v
136:  180  format ('VecSwap ',1pe9.2)

138:       PetscCallA(VecWAXPY(w,two,x,y,ierr))
139:       PetscCallA(VecNorm(w,NORM_2,norm,ierr))
140:       v = abs(norm-38.0*sqrt(nfloat))
141:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
142:       if (rank == 0) write(6,190) v
143:  190  format ('VecWAXPY ',1pe9.2)

145:       PetscCallA(VecPointwiseMult(w,y,x,ierr))
146:       PetscCallA(VecNorm(w,NORM_2,norm,ierr))
147:       v = abs(norm-36.0*sqrt(nfloat))
148:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
149:       if (rank == 0) write(6,200) v
150:  200  format ('VecPointwiseMult ',1pe9.2)

152:       PetscCallA(VecPointwiseDivide(w,x,y,ierr))
153:       PetscCallA(VecNorm(w,NORM_2,norm,ierr))
154:       v = abs(norm-9.0*sqrt(nfloat))
155:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
156:       if (rank == 0) write(6,210) v
157:  210  format ('VecPointwiseDivide ',1pe9.2)

159:       dots(1) = one
160:       dots(2) = three
161:       dots(3) = two
162:       PetscCallA(VecSet(x,one,ierr))
163:       PetscCallA(VecMAXPY(x,ithree,dots,z,ierr))
164:       PetscCallA(VecNorm(z(1),NORM_2,norm,ierr))
165:       v = abs(norm-sqrt(nfloat))
166:       if (v .gt. -PETSC_SMALL .and. v .lt. PETSC_SMALL) v = 0.0
167:       PetscCallA(VecNorm(z(2),NORM_2,norm,ierr))
168:       v1 = abs(norm-2.0*sqrt(nfloat))
169:       if (v1 .gt. -PETSC_SMALL .and. v1 .lt. PETSC_SMALL) v1 = 0.0
170:       PetscCallA(VecNorm(z(3),NORM_2,norm,ierr))
171:       v2 = abs(norm-3.0*sqrt(nfloat))
172:       if (v2 .gt. -PETSC_SMALL .and. v2 .lt. PETSC_SMALL) v2 = 0.0
173:       if (rank .eq. 0) write(6,220) v,v1,v2
174:  220  format ('VecMAXPY ',3(2x,1pe9.2))

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

179:       PetscCallA(VecDestroy(x,ierr))
180:       PetscCallA(VecDestroy(y,ierr))
181:       PetscCallA(VecDestroy(w,ierr))
182:       PetscCallA(VecDestroyVecs(ithree,z,ierr))
183:       PetscCallA(PetscFinalize(ierr))

185:       end

187: !
188: !/*TEST
189: !
190: !     test:
191: !       suffix: 1
192: !
193: !     test:
194: !       suffix: 2
195: !       nsize: 2
196: !
197: !TEST*/