Date: 2025-03-28T21:10:51+00:00

Actual source code: ex11f90.F90

      1:       program main
      2: !-----------------------------------------------------------------------
      3: !
      4: !    Tests DMDAGetVecGetArray()
      5: !-----------------------------------------------------------------------
      6: !

      8: #include <petsc/finclude/petscdm.h>
      9:       use petsc
     10:       implicit none

     12:       Type(tVec)  g
     13:       Type(tDM)   ada

     15:       PetscScalar,pointer :: x1(:),x2(:,:)
     16:       PetscScalar,pointer :: x3(:,:,:),x4(:,:,:,:)
     17:       PetscErrorCode ierr
     18:       PetscInt m,n,p,dof,s,i,j,k,xs,xl
     19:       PetscInt ys,yl
     20:       PetscInt zs,zl,sw

     22:       PetscInt nen,nel
     23:       PetscInt, pointer :: elements(:)

     25:       m = 5
     26:       n = 6
     27:       p = 4;
     28:       s = 1
     29:       dof = 1
     30:       sw = 1
     31:       PetscCallA(PetscInitialize(ierr))
     32:       PetscCallA(DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,m,dof,sw,PETSC_NULL_INTEGER_ARRAY,ada,ierr))
     33:       PetscCallA(DMSetUp(ada,ierr))
     34:       PetscCallA(DMGetGlobalVector(ada,g,ierr))
     35:       PetscCallA(DMDAGetCorners(ada,xs,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,xl,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr))
     36:       PetscCallA(DMDAVecGetArrayF90(ada,g,x1,ierr))
     37:       do i=xs,xs+xl-1
     38: !         CHKMEMQ
     39:          x1(i) = i
     40: !         CHKMEMQ
     41:       enddo
     42:       PetscCallA(DMDAVecRestoreArrayF90(ada,g,x1,ierr))
     43:       PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
     44:       PetscCallA(DMRestoreGlobalVector(ada,g,ierr))
     45:       PetscCallA(DMDestroy(ada,ierr))

     47:       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))
     48:       PetscCallA(DMSetUp(ada,ierr))
     49:       PetscCallA(DMGetGlobalVector(ada,g,ierr))
     50:       PetscCallA(DMDAGetCorners(ada,xs,ys,PETSC_NULL_INTEGER,xl,yl,PETSC_NULL_INTEGER,ierr))
     51:       PetscCallA(DMDAVecGetArrayF90(ada,g,x2,ierr))
     52:       do i=xs,xs+xl-1
     53:         do j=ys,ys+yl-1
     54: !           CHKMEMQ
     55:            x2(i,j) = i + j
     56: !           CHKMEMQ
     57:         enddo
     58:       enddo
     59:       PetscCallA(DMDAVecRestoreArrayF90(ada,g,x2,ierr))
     60:       PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
     61:       PetscCallA(DMRestoreGlobalVector(ada,g,ierr))

     63:       PetscCallA(DMDAGetElements(ada,nen,nel,elements,ierr))
     64:       do i=1,nen*nel
     65:          PetscCheckA(elements(i) .ge. 0,PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error getting DMDA elements')
     66:       enddo
     67:       PetscCallA(DMDARestoreElements(ada,nen,nel,elements,ierr))
     68:       PetscCallA(DMDestroy(ada,ierr))

     70:       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))
     71:       PetscCallA(DMSetUp(ada,ierr))
     72:       PetscCallA(DMGetGlobalVector(ada,g,ierr))
     73:       PetscCallA(DMDAGetCorners(ada,xs,ys,zs,xl,yl,zl,ierr))
     74:       PetscCallA(DMDAVecGetArrayF90(ada,g,x3,ierr))
     75:       do i=xs,xs+xl-1
     76:         do j=ys,ys+yl-1
     77:           do k=zs,zs+zl-1
     78: !            CHKMEMQ
     79:             x3(i,j,k) = i + j + k
     80: !            CHKMEMQ
     81:           enddo
     82:         enddo
     83:       enddo
     84:       PetscCallA(DMDAVecRestoreArrayF90(ada,g,x3,ierr))
     85:       PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
     86:       PetscCallA(DMRestoreGlobalVector(ada,g,ierr))
     87:       PetscCallA(DMDestroy(ada,ierr))

     89: !
     90: !  Same tests but now with DOF > 1, so dimensions of array are one higher
     91: !
     92:       dof = 2
     93:       PetscCallA(DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,m,dof,sw,PETSC_NULL_INTEGER_ARRAY,ada,ierr))
     94:       PetscCallA(DMSetUp(ada,ierr))
     95:       PetscCallA(DMGetGlobalVector(ada,g,ierr))
     96:       PetscCallA(DMDAGetCorners(ada,xs,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,xl,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr))
     97:       PetscCallA(DMDAVecGetArrayF90(ada,g,x2,ierr))
     98:       do i=xs,xs+xl-1
     99: !         CHKMEMQ
    100:          x2(0,i) = i
    101:          x2(1,i) = -i
    102: !         CHKMEMQ
    103:       enddo
    104:       PetscCallA(DMDAVecRestoreArrayF90(ada,g,x1,ierr))
    105:       PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
    106:       PetscCallA(DMRestoreGlobalVector(ada,g,ierr))
    107:       PetscCallA(DMDestroy(ada,ierr))

    109:       dof = 2
    110:       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))
    111:       PetscCallA(DMSetUp(ada,ierr))
    112:       PetscCallA(DMGetGlobalVector(ada,g,ierr))
    113:       PetscCallA(DMDAGetCorners(ada,xs,ys,PETSC_NULL_INTEGER,xl,yl,PETSC_NULL_INTEGER,ierr))
    114:       PetscCallA(DMDAVecGetArrayF90(ada,g,x3,ierr))
    115:       do i=xs,xs+xl-1
    116:         do j=ys,ys+yl-1
    117: !           CHKMEMQ
    118:            x3(0,i,j) = i + j
    119:            x3(1,i,j) = -(i + j)
    120: !           CHKMEMQ
    121:         enddo
    122:       enddo
    123:       PetscCallA(DMDAVecRestoreArrayF90(ada,g,x3,ierr))
    124:       PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
    125:       PetscCallA(DMRestoreGlobalVector(ada,g,ierr))
    126:       PetscCallA(DMDestroy(ada,ierr))

    128:       dof = 3
    129:       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))
    130:       PetscCallA(DMSetUp(ada,ierr))
    131:       PetscCallA(DMGetGlobalVector(ada,g,ierr))
    132:       PetscCallA(DMDAGetCorners(ada,xs,ys,zs,xl,yl,zl,ierr))
    133:       PetscCallA(DMDAVecGetArrayF90(ada,g,x4,ierr))
    134:       do i=xs,xs+xl-1
    135:         do j=ys,ys+yl-1
    136:           do k=zs,zs+zl-1
    137: !            CHKMEMQ
    138:             x4(0,i,j,k) = i + j + k
    139:             x4(1,i,j,k) = -(i + j + k)
    140:             x4(2,i,j,k) = i + j + k
    141: !            CHKMEMQ
    142:           enddo
    143:         enddo
    144:       enddo
    145:       PetscCallA(DMDAVecRestoreArrayF90(ada,g,x4,ierr))
    146:       PetscCallA(VecView(g,PETSC_VIEWER_STDOUT_WORLD,ierr))
    147:       PetscCallA(DMRestoreGlobalVector(ada,g,ierr))
    148:       PetscCallA(DMDestroy(ada,ierr))

    150:       PetscCallA(PetscFinalize(ierr))
    151:       END PROGRAM

    153: !
    154: !/*TEST
    155: !
    156: !   build:
    157: !     requires: !complex
    158: !
    159: !   test:
    160: !     filter: Error: grep -v "Vec Object" | grep -v "Warning: ieee_inexact is signaling"
    161: !
    162: !TEST*/