Actual source code: ex21f.F
1: !
2: !
3: program main
4: #include include/finclude/petsc.h
5: #include include/finclude/petscvec.h
6: #include include/finclude/petscda.h
8: ! For testing purposes this example also creates a
9: ! DA context. Actually codes using SDA routines will probably
10: ! not also work with DA contexts.
13: integer MM,ierr,dof,stencil_width,flg,i,start,end,PP
14: integer flg2,flg3,NN,m,n,p
15: PetscOffset in_idx,out_idx
16: DAPeriodicType periodic
17: DAStencilType stencil_type
18: DA da
19: integer sda
20: Vec local,global,local_copy
21: PetscScalar value,mone,in(1),out(1)
22: PetscScalar norm,work
23:
24: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
26: m = PETSC_DECIDE
27: n = PETSC_DECIDE
28: p = PETSC_DECIDE
29: MM = 8
30: NN = 6
31: PP = 5
32: dof = 1
33: stencil_width = 1
34: periodic = DA_NONPERIODIC
35: stencil_type = DA_STENCIL_STAR
38: call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-M',MM,flg,ierr)
39: call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-N',NN,flg,ierr)
40: call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-dof',dof,flg,ierr)
41: call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-stencil_width', &
42: & stencil_width,flg,ierr)
43: call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-periodic',periodic, &
44: & flg,ierr)
45: call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-stencil_type', &
46: & stencil_type,flg,ierr)
48: call PetscOptionsHasName(PETSC_NULL_CHARACTER,'-2d',flg2,ierr)
49: call PetscOptionsHasName(PETSC_NULL_CHARACTER,'-3d',flg3,ierr)
50: if (flg2 .ne. 0) then
51: call DACreate2d(PETSC_COMM_WORLD,periodic,stencil_type, &
52: & MM,NN,m,n,dof,stencil_width,PETSC_NULL_INTEGER, &
53: & PETSC_NULL_INTEGER,da,ierr)
54: call SDACreate2d(PETSC_COMM_WORLD,periodic,stencil_type, &
55: & MM,NN,m,n,dof,stencil_width,PETSC_NULL_INTEGER, &
56: & PETSC_NULL_INTEGER,sda,ierr)
57: else if (flg3 .ne. 0) then
58: call DACreate3d(PETSC_COMM_WORLD,periodic,stencil_type, &
59: & MM,NN,PP,m,n,p,dof,stencil_width,PETSC_NULL_INTEGER, &
60: & PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,da,ierr)
61: call SDACreate3d(PETSC_COMM_WORLD,periodic,stencil_type, &
62: & MM,NN,PP,m,n,p,dof,stencil_width,PETSC_NULL_INTEGER, &
63: & PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,sda,ierr)
64: else
65: call DACreate1d(PETSC_COMM_WORLD,periodic,MM,dof, &
66: & stencil_width,PETSC_NULL,da,ierr)
67: call SDACreate1d(PETSC_COMM_WORLD,periodic,MM,dof, &
68: & stencil_width,PETSC_NULL_INTEGER,sda,ierr)
69: endif
71: call DACreateGlobalVector(da,global,ierr)
72: call DACreateLocalVector(da,local,ierr)
73: call VecDuplicate(local,local_copy,ierr)
75:
76: ! zero out vectors so that ghostpoints are zero
77: value = 0.0
78: call VecSet(local,value,ierr)
79: call VecSet(local_copy,value,ierr)
81: call VecGetOwnershipRange(global,start,end,ierr)
82: do 10, i=start,end-1
83: value = i + 1
84: call VecSetValues(global,1,i,value,INSERT_VALUES,ierr)
85: 10 continue
86: call VecAssemblyBegin(global,ierr)
87: call VecAssemblyEnd(global,ierr)
89: call DAGlobalToLocalBegin(da,global,INSERT_VALUES,local, &
90: & ierr)
91: call DAGlobalToLocalEnd(da,global,INSERT_VALUES,local,ierr)
94: call VecGetArray(local,out,out_idx,ierr)
95: call VecGetArray(local_copy,in,in_idx,ierr)
96: call SDALocalToLocalBegin(sda,out(out_idx+1),INSERT_VALUES, &
97: & in(in_idx+1),ierr)
98: call SDALocalToLocalEnd(sda,out(out_idx+1),INSERT_VALUES, &
99: & in(in_idx+1),ierr)
101: mone = -1.0
102: call VecAXPY(local_copy,mone,local,ierr)
103: call VecNorm(local_copy,NORM_MAX,work,ierr)
104: call MPI_Allreduce(work, norm,1,MPIU_REAL_PRECISION,MPI_MAX, &
105: & PETSC_COMM_WORLD,ierr)
106: print*,'Norm of difference ',norm,' should be zero'
107:
108: call DADestroy(da,ierr)
109: call SDADestroy(sda,ierr)
110: call VecDestroy(local_copy,ierr)
112: call VecDestroy(local,ierr)
113: call VecDestroy(global,ierr)
114: call PetscFinalize(ierr)
115: end