Actual source code: ex11f90.F

petsc-3.4.4 2014-03-13
  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
 26:       Type(DM)   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