Actual source code: ex11f90.F
petsc-3.3-p7 2013-05-11
1: !-----------------------------------------------------------------------
2: !
3: ! Tests DMDAGetVecGetArray()
4: !-----------------------------------------------------------------------
5: !
7: !#define PETSC_USE_FORTRAN_MODULES 1
8: #include <finclude/petscsysdef.h>
9: #include <finclude/petscvecdef.h>
10: #include <finclude/petscdmdef.h>
11: #if defined(PETSC_USE_FORTRAN_MODULES) || defined(PETSC_USE_FORTRAN_DATATYPES)
12: use petsc
13: #endif
14: implicit none
15: #if !defined(PETSC_USE_FORTRAN_MODULES) && !defined(PETSC_USE_FORTRAN_DATATYPES)
16: #include <finclude/petscsys.h>
17: #include <finclude/petscvec.h>
18: #include <finclude/petscdmda.h>
19: #include <finclude/petscvec.h90>
20: #include <finclude/petscdmda.h90>
21: #include <finclude/petscviewer.h>
22: #endif
24: #if defined(PETSC_USE_FORTRAN_DATATYPES)
25: Type(Vec) g,l
26: Type ada
27: #else
28: Vec g
29: DM ada
30: #endif
31: PetscScalar,pointer :: x1(:),x2(:,:)
32: PetscScalar,pointer :: x3(:,:,:),x4(:,:,:,:)
33: PetscErrorCode ierr
34: PetscInt m,n,p,dof,s,i,j,k,xs,xl
35: PetscInt ys,yl
36: PetscInt zs,zl
38: m = 5
39: n = 6
40: p = 4;
41: s = 1
42: dof = 1
43: CALL PetscInitialize(PETSC_NULL_CHARACTER,ierr)
44: call DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,m,dof,1, &
45: & PETSC_NULL_INTEGER,ada,ierr)
46: call DMGetGlobalVector(ada,g,ierr)
47: call DMDAGetCorners(ada,xs,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
48: & xl,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr)
49: call DMDAVecGetArrayF90(ada,g,x1,ierr)
50: do i=xs,xs+xl-1
51: ! CHKMEMQ
52: x1(i) = i
53: ! CHKMEMQ
54: enddo
55: call DMDAVecRestoreArrayF90(ada,g,x1,ierr)
56: call VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr)
57: call DMRestoreGlobalVector(ada,g,ierr)
58: call DMDestroy(ada,ierr)
60: call DMDACreate2d(PETSC_COMM_WORLD, &
61: & DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE, &
62: & DMDA_STENCIL_BOX,m,n,PETSC_DECIDE,PETSC_DECIDE,dof,s, &
63: & PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ada,ierr)
64: call DMGetGlobalVector(ada,g,ierr)
65: call DMDAGetCorners(ada,xs,ys,PETSC_NULL_INTEGER, &
66: & xl,yl,PETSC_NULL_INTEGER,ierr)
67: call DMDAVecGetArrayF90(ada,g,x2,ierr)
68: do i=xs,xs+xl-1
69: do j=ys,ys+yl-1
70: ! CHKMEMQ
71: x2(i,j) = i + j
72: ! CHKMEMQ
73: enddo
74: enddo
75: call DMDAVecRestoreArrayF90(ada,g,x2,ierr)
76: call VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr)
77: call DMRestoreGlobalVector(ada,g,ierr)
78: call DMDestroy(ada,ierr)
80: call DMDACreate3d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE, &
81: & DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE, &
82: & DMDA_STENCIL_BOX, m,n,p,PETSC_DECIDE,PETSC_DECIDE, &
83: & PETSC_DECIDE,dof,s, &
84: & PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
85: & PETSC_NULL_INTEGER,ada,ierr)
86: call DMGetGlobalVector(ada,g,ierr)
87: call DMDAGetCorners(ada,xs,ys,zs, &
88: & xl,yl,zl,ierr)
89: call DMDAVecGetArrayF90(ada,g,x3,ierr)
90: do i=xs,xs+xl-1
91: do j=ys,ys+yl-1
92: do k=zs,zs+zl-1
93: ! CHKMEMQ
94: x3(i,j,k) = i + j + k
95: ! CHKMEMQ
96: enddo
97: enddo
98: enddo
99: call DMDAVecRestoreArrayF90(ada,g,x3,ierr)
100: call VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr)
101: call DMRestoreGlobalVector(ada,g,ierr)
102: call DMDestroy(ada,ierr)
104: !
105: ! Same tests but now with DOF > 1, so dimensions of array are one higher
106: !
107: dof = 2
108: CALL PetscInitialize(PETSC_NULL_CHARACTER,ierr)
109: call DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,m,dof,1, &
110: & PETSC_NULL_INTEGER,ada,ierr)
111: call DMGetGlobalVector(ada,g,ierr)
112: call DMDAGetCorners(ada,xs,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
113: & xl,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr)
114: call DMDAVecGetArrayF90(ada,g,x2,ierr)
115: do i=xs,xs+xl-1
116: ! CHKMEMQ
117: x2(0,i) = i
118: x2(1,i) = -i
119: ! CHKMEMQ
120: enddo
121: call DMDAVecRestoreArrayF90(ada,g,x1,ierr)
122: call VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr)
123: call DMRestoreGlobalVector(ada,g,ierr)
124: call DMDestroy(ada,ierr)
126: dof = 2
127: call DMDACreate2d(PETSC_COMM_WORLD, &
128: & DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE, &
129: & DMDA_STENCIL_BOX,m,n,PETSC_DECIDE,PETSC_DECIDE,dof,s, &
130: & PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ada,ierr)
131: call DMGetGlobalVector(ada,g,ierr)
132: call DMDAGetCorners(ada,xs,ys,PETSC_NULL_INTEGER, &
133: & xl,yl,PETSC_NULL_INTEGER,ierr)
134: call DMDAVecGetArrayF90(ada,g,x3,ierr)
135: do i=xs,xs+xl-1
136: do j=ys,ys+yl-1
137: ! CHKMEMQ
138: x3(0,i,j) = i + j
139: x3(1,i,j) = -(i + j)
140: ! CHKMEMQ
141: enddo
142: enddo
143: call DMDAVecRestoreArrayF90(ada,g,x3,ierr)
144: call VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr)
145: call DMRestoreGlobalVector(ada,g,ierr)
146: call DMDestroy(ada,ierr)
148: dof = 3
149: call DMDACreate3d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE, &
150: & DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE, &
151: & DMDA_STENCIL_BOX,m,n,p,PETSC_DECIDE,PETSC_DECIDE, &
152: & PETSC_DECIDE,dof,s, &
153: & PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
154: & PETSC_NULL_INTEGER,ada,ierr)
155: call DMGetGlobalVector(ada,g,ierr)
156: call DMDAGetCorners(ada,xs,ys,zs, &
157: & xl,yl,zl,ierr)
158: call DMDAVecGetArrayF90(ada,g,x4,ierr)
159: do i=xs,xs+xl-1
160: do j=ys,ys+yl-1
161: do k=zs,zs+zl-1
162: ! CHKMEMQ
163: x4(0,i,j,k) = i + j + k
164: x4(1,i,j,k) = -(i + j + k)
165: x4(2,i,j,k) = i + j + k
166: ! CHKMEMQ
167: enddo
168: enddo
169: enddo
170: call DMDAVecRestoreArrayF90(ada,g,x4,ierr)
171: call VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr)
172: call DMRestoreGlobalVector(ada,g,ierr)
173: call DMDestroy(ada,ierr)
175: CALL PetscFinalize(ierr)
176: stop
177: END PROGRAM