xref: /petsc/src/dm/tutorials/ex11f90.F90 (revision 8d9ecca5a504194654f5c92cc5cdc8b5689a3cbe)
1c4762a1bSJed Brown!     Tests DMDAGetVecGetArray()
2c4762a1bSJed Brown
3ce78bad3SBarry Smith      program main
4c4762a1bSJed Brown#include <petsc/finclude/petscdm.h>
5ce78bad3SBarry Smith#include <petsc/finclude/petscdmda.h>
6ce78bad3SBarry Smith      use petscdmda
7c4762a1bSJed Brown      use petsc
8c4762a1bSJed Brown      implicit none
9c4762a1bSJed Brown
10c4762a1bSJed Brown      Type(tVec)  g
11c4762a1bSJed Brown      Type(tDM)   ada
12c4762a1bSJed Brown
13c4762a1bSJed Brown      PetscScalar,pointer :: x1(:),x2(:,:)
14c4762a1bSJed Brown      PetscScalar,pointer :: x3(:,:,:),x4(:,:,:,:)
15c4762a1bSJed Brown      PetscErrorCode ierr
16c4762a1bSJed Brown      PetscInt m,n,p,dof,s,i,j,k,xs,xl
17c4762a1bSJed Brown      PetscInt ys,yl
18c4762a1bSJed Brown      PetscInt zs,zl,sw
19c4762a1bSJed Brown
20659f25fdSBarry Smith      PetscInt nen,nel
21659f25fdSBarry Smith      PetscInt, pointer :: elements(:)
22659f25fdSBarry Smith
23*8d9ecca5SBarry Smith      PetscInt nfields
24*8d9ecca5SBarry Smith      character(80), pointer :: namefields(:)
25*8d9ecca5SBarry Smith      IS, pointer :: isfields(:)
26*8d9ecca5SBarry Smith      DM, pointer :: dmfields(:)
27*8d9ecca5SBarry Smith      PetscInt zero, one
28*8d9ecca5SBarry Smith
29c4762a1bSJed Brown      m = 5
30c4762a1bSJed Brown      n = 6
31c4762a1bSJed Brown      p = 4;
32c4762a1bSJed Brown      s = 1
33c4762a1bSJed Brown      dof = 1
34c4762a1bSJed Brown      sw = 1
35*8d9ecca5SBarry Smith      zero = 0
36*8d9ecca5SBarry Smith      one = 1
37d8606c27SBarry Smith      PetscCallA(PetscInitialize(ierr))
385d83a8b1SBarry Smith      PetscCallA(DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,m,dof,sw,PETSC_NULL_INTEGER_ARRAY,ada,ierr))
39d8606c27SBarry Smith      PetscCallA(DMSetUp(ada,ierr))
40d8606c27SBarry Smith      PetscCallA(DMGetGlobalVector(ada,g,ierr))
41d8606c27SBarry Smith      PetscCallA(DMDAGetCorners(ada,xs,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,xl,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr))
42ce78bad3SBarry Smith      PetscCallA(DMDAVecGetArray(ada,g,x1,ierr))
43c4762a1bSJed Brown      do i=xs,xs+xl-1
44c4762a1bSJed Brown!         CHKMEMQ
45c4762a1bSJed Brown         x1(i) = i
46c4762a1bSJed Brown!         CHKMEMQ
47c4762a1bSJed Brown      enddo
48ce78bad3SBarry Smith      PetscCallA(DMDAVecRestoreArray(ada,g,x1,ierr))
49d8606c27SBarry Smith      PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
50d8606c27SBarry Smith      PetscCallA(DMRestoreGlobalVector(ada,g,ierr))
51d8606c27SBarry Smith      PetscCallA(DMDestroy(ada,ierr))
52c4762a1bSJed Brown
535d83a8b1SBarry Smith      PetscCallA(DMDACreate2d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_BOX,m,n,PETSC_DECIDE,PETSC_DECIDE,dof,s,PETSC_NULL_INTEGER_ARRAY,PETSC_NULL_INTEGER_ARRAY,ada,ierr))
54d8606c27SBarry Smith      PetscCallA(DMSetUp(ada,ierr))
55d8606c27SBarry Smith      PetscCallA(DMGetGlobalVector(ada,g,ierr))
56d8606c27SBarry Smith      PetscCallA(DMDAGetCorners(ada,xs,ys,PETSC_NULL_INTEGER,xl,yl,PETSC_NULL_INTEGER,ierr))
57ce78bad3SBarry Smith      PetscCallA(DMDAVecGetArray(ada,g,x2,ierr))
58c4762a1bSJed Brown      do i=xs,xs+xl-1
59c4762a1bSJed Brown        do j=ys,ys+yl-1
60c4762a1bSJed Brown!           CHKMEMQ
61c4762a1bSJed Brown           x2(i,j) = i + j
62c4762a1bSJed Brown!           CHKMEMQ
63c4762a1bSJed Brown        enddo
64c4762a1bSJed Brown      enddo
65ce78bad3SBarry Smith      PetscCallA(DMDAVecRestoreArray(ada,g,x2,ierr))
66d8606c27SBarry Smith      PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
67d8606c27SBarry Smith      PetscCallA(DMRestoreGlobalVector(ada,g,ierr))
68659f25fdSBarry Smith
69659f25fdSBarry Smith      PetscCallA(DMDAGetElements(ada,nen,nel,elements,ierr))
70659f25fdSBarry Smith      do i=1,nen*nel
71659f25fdSBarry Smith         PetscCheckA(elements(i) .ge. 0,PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error getting DMDA elements')
72659f25fdSBarry Smith      enddo
73659f25fdSBarry Smith      PetscCallA(DMDARestoreElements(ada,nen,nel,elements,ierr))
74d8606c27SBarry Smith      PetscCallA(DMDestroy(ada,ierr))
75c4762a1bSJed Brown
765d83a8b1SBarry Smith      PetscCallA(DMDACreate3d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_BOX, m,n,p,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,dof,s,PETSC_NULL_INTEGER_ARRAY,PETSC_NULL_INTEGER_ARRAY,PETSC_NULL_INTEGER_ARRAY,ada,ierr))
77d8606c27SBarry Smith      PetscCallA(DMSetUp(ada,ierr))
78d8606c27SBarry Smith      PetscCallA(DMGetGlobalVector(ada,g,ierr))
79d8606c27SBarry Smith      PetscCallA(DMDAGetCorners(ada,xs,ys,zs,xl,yl,zl,ierr))
80ce78bad3SBarry Smith      PetscCallA(DMDAVecGetArray(ada,g,x3,ierr))
81c4762a1bSJed Brown      do i=xs,xs+xl-1
82c4762a1bSJed Brown        do j=ys,ys+yl-1
83c4762a1bSJed Brown          do k=zs,zs+zl-1
84c4762a1bSJed Brown!            CHKMEMQ
85c4762a1bSJed Brown            x3(i,j,k) = i + j + k
86c4762a1bSJed Brown!            CHKMEMQ
87c4762a1bSJed Brown          enddo
88c4762a1bSJed Brown        enddo
89c4762a1bSJed Brown      enddo
90ce78bad3SBarry Smith      PetscCallA(DMDAVecRestoreArray(ada,g,x3,ierr))
91d8606c27SBarry Smith      PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
92d8606c27SBarry Smith      PetscCallA(DMRestoreGlobalVector(ada,g,ierr))
93d8606c27SBarry Smith      PetscCallA(DMDestroy(ada,ierr))
94c4762a1bSJed Brown
95c4762a1bSJed Brown!
96c4762a1bSJed Brown!  Same tests but now with DOF > 1, so dimensions of array are one higher
97c4762a1bSJed Brown!
98c4762a1bSJed Brown      dof = 2
995d83a8b1SBarry Smith      PetscCallA(DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,m,dof,sw,PETSC_NULL_INTEGER_ARRAY,ada,ierr))
100d8606c27SBarry Smith      PetscCallA(DMSetUp(ada,ierr))
101d8606c27SBarry Smith      PetscCallA(DMGetGlobalVector(ada,g,ierr))
102d8606c27SBarry Smith      PetscCallA(DMDAGetCorners(ada,xs,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,xl,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr))
103ce78bad3SBarry Smith      PetscCallA(DMDAVecGetArray(ada,g,x2,ierr))
104c4762a1bSJed Brown      do i=xs,xs+xl-1
105c4762a1bSJed Brown!         CHKMEMQ
106c4762a1bSJed Brown         x2(0,i) = i
107c4762a1bSJed Brown         x2(1,i) = -i
108c4762a1bSJed Brown!         CHKMEMQ
109c4762a1bSJed Brown      enddo
110ce78bad3SBarry Smith      PetscCallA(DMDAVecRestoreArray(ada,g,x1,ierr))
111d8606c27SBarry Smith      PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
112d8606c27SBarry Smith      PetscCallA(DMRestoreGlobalVector(ada,g,ierr))
113*8d9ecca5SBarry Smith
114*8d9ecca5SBarry Smith      ! some testing unrelated to the example
115*8d9ecca5SBarry Smith      PetscCallA(DMDASetFieldName(ada,zero,'Field 0',ierr))
116*8d9ecca5SBarry Smith      PetscCallA(DMDASetFieldName(ada,one,'Field 1',ierr))
117*8d9ecca5SBarry Smith      PetscCallA(DMCreateFieldDecomposition(ada, nfields, namefields, PETSC_NULL_IS_POINTER, PETSC_NULL_DM_POINTER, ierr))
118*8d9ecca5SBarry Smith      ! print*,nfields,trim(namefields(1)),trim(namefields(2))
119*8d9ecca5SBarry Smith      PetscCallA(DMDestroyFieldDecomposition(ada, nfields, namefields, PETSC_NULL_IS_POINTER, PETSC_NULL_DM_POINTER, ierr))
120*8d9ecca5SBarry Smith      PetscCallA(DMCreateFieldDecomposition(ada, nfields, namefields, isfields, dmfields, ierr))
121*8d9ecca5SBarry Smith      PetscCallA(DMDestroyFieldDecomposition(ada, nfields, namefields, isfields, dmfields, ierr))
122*8d9ecca5SBarry Smith
123d8606c27SBarry Smith      PetscCallA(DMDestroy(ada,ierr))
124c4762a1bSJed Brown
125c4762a1bSJed Brown      dof = 2
1265d83a8b1SBarry Smith      PetscCallA(DMDACreate2d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_BOX,m,n,PETSC_DECIDE,PETSC_DECIDE,dof,s,PETSC_NULL_INTEGER_ARRAY,PETSC_NULL_INTEGER_ARRAY,ada,ierr))
127d8606c27SBarry Smith      PetscCallA(DMSetUp(ada,ierr))
128d8606c27SBarry Smith      PetscCallA(DMGetGlobalVector(ada,g,ierr))
129d8606c27SBarry Smith      PetscCallA(DMDAGetCorners(ada,xs,ys,PETSC_NULL_INTEGER,xl,yl,PETSC_NULL_INTEGER,ierr))
130ce78bad3SBarry Smith      PetscCallA(DMDAVecGetArray(ada,g,x3,ierr))
131c4762a1bSJed Brown      do i=xs,xs+xl-1
132c4762a1bSJed Brown        do j=ys,ys+yl-1
133c4762a1bSJed Brown!           CHKMEMQ
134c4762a1bSJed Brown           x3(0,i,j) = i + j
135c4762a1bSJed Brown           x3(1,i,j) = -(i + j)
136c4762a1bSJed Brown!           CHKMEMQ
137c4762a1bSJed Brown        enddo
138c4762a1bSJed Brown      enddo
139ce78bad3SBarry Smith      PetscCallA(DMDAVecRestoreArray(ada,g,x3,ierr))
140d8606c27SBarry Smith      PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
141d8606c27SBarry Smith      PetscCallA(DMRestoreGlobalVector(ada,g,ierr))
142d8606c27SBarry Smith      PetscCallA(DMDestroy(ada,ierr))
143c4762a1bSJed Brown
144c4762a1bSJed Brown      dof = 3
1455d83a8b1SBarry Smith      PetscCallA(DMDACreate3d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_BOX,m,n,p,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,dof,s,PETSC_NULL_INTEGER_ARRAY,PETSC_NULL_INTEGER_ARRAY,PETSC_NULL_INTEGER_ARRAY,ada,ierr))
146d8606c27SBarry Smith      PetscCallA(DMSetUp(ada,ierr))
147d8606c27SBarry Smith      PetscCallA(DMGetGlobalVector(ada,g,ierr))
148d8606c27SBarry Smith      PetscCallA(DMDAGetCorners(ada,xs,ys,zs,xl,yl,zl,ierr))
149ce78bad3SBarry Smith      PetscCallA(DMDAVecGetArray(ada,g,x4,ierr))
150c4762a1bSJed Brown      do i=xs,xs+xl-1
151c4762a1bSJed Brown        do j=ys,ys+yl-1
152c4762a1bSJed Brown          do k=zs,zs+zl-1
153c4762a1bSJed Brown!            CHKMEMQ
154c4762a1bSJed Brown            x4(0,i,j,k) = i + j + k
155c4762a1bSJed Brown            x4(1,i,j,k) = -(i + j + k)
156c4762a1bSJed Brown            x4(2,i,j,k) = i + j + k
157c4762a1bSJed Brown!            CHKMEMQ
158c4762a1bSJed Brown          enddo
159c4762a1bSJed Brown        enddo
160c4762a1bSJed Brown      enddo
161ce78bad3SBarry Smith      PetscCallA(DMDAVecRestoreArray(ada,g,x4,ierr))
162d8606c27SBarry Smith      PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
163d8606c27SBarry Smith      PetscCallA(DMRestoreGlobalVector(ada,g,ierr))
164d8606c27SBarry Smith      PetscCallA(DMDestroy(ada,ierr))
165c4762a1bSJed Brown
166d8606c27SBarry Smith      PetscCallA(PetscFinalize(ierr))
167c4762a1bSJed Brown      END PROGRAM
168c4762a1bSJed Brown
169c4762a1bSJed Brown!
170c4762a1bSJed Brown!/*TEST
171c4762a1bSJed Brown!
172c4762a1bSJed Brown!   build:
173c4762a1bSJed Brown!     requires: !complex
174c4762a1bSJed Brown!
175c4762a1bSJed Brown!   test:
176c4762a1bSJed Brown!     filter: Error: grep -v "Vec Object" | grep -v "Warning: ieee_inexact is signaling"
177c4762a1bSJed Brown!
178c4762a1bSJed Brown!TEST*/
179