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