Actual source code: ex30f.F
petsc-3.12.4 2020-02-04
Report Typos and Errors

      1: !
      2: !
      3: !  Tests parallel to parallel scatter where a to from index are
      4: !  duplicated
      5:       program main
      6:  #include <petsc/finclude/petscvec.h>
      7:       use petscvec
      8:       implicit none

     10:       PetscErrorCode ierr
     11:       PetscInt  nlocal, n, row
     12:       PetscInt  nlocal2,n2,eight
     13:       PetscMPIInt rank, size
     14:       PetscInt from(10), to(10)

     16:       PetscScalar num
     17:       Vec v1, v2, v3
     18:       VecScatter scat1, scat2
     19:       IS fromis, tois
     20:       n=8
     21:       nlocal=2
     22:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
     23:       if (ierr .ne. 0) then
     24:         print*,'Unable to initialize PETSc'
     25:         stop
     26:       endif
     27:       call MPI_COMM_RANK(PETSC_COMM_WORLD,rank,ierr)
     28:       call MPI_COMM_SIZE(PETSC_COMM_WORLD,size,ierr)
     29:       if (size.ne.4) then
     30:          print *, 'Four processor test'
     31:          stop
     32:       end if

     34:       nlocal2 = 2*nlocal
     35:       n2      = 2*n
     36:       call VecCreateMPI(PETSC_COMM_WORLD,nlocal2,n2,v1,ierr)
     37:       call VecCreateMPI(PETSC_COMM_WORLD,nlocal,n,v2,ierr)
     38:       call VecCreateSeq(PETSC_COMM_SELF,n,v3,ierr)

     40:       num=2.0
     41:       row = 1
     42:       call VecSetValue(v1,row,num,INSERT_VALUES,ierr)
     43:       row = 5
     44:       call VecSetValue(v1,row,num,INSERT_VALUES,ierr)
     45:       row = 9
     46:       call VecSetValue(v1,row,num,INSERT_VALUES,ierr)
     47:       row = 13
     48:       call VecSetValue(v1,row,num,INSERT_VALUES,ierr)
     49:       num=1.0
     50:       row = 15
     51:       call VecSetValue(v1,row,num,INSERT_VALUES,ierr)
     52:       row = 3
     53:       call VecSetValue(v1,row,num,INSERT_VALUES,ierr)
     54:       row = 7
     55:       call VecSetValue(v1,row,num,INSERT_VALUES,ierr)
     56:       row = 11
     57:       call VecSetValue(v1,row,num,INSERT_VALUES,ierr)

     59:       call VecAssemblyBegin(v1,ierr)
     60:       call VecAssemblyEnd(v1,ierr)

     62:       num=0.0
     63:       call VecScale(v2,num,ierr)
     64:       call VecScale(v3,num,ierr)

     66:       from(1)=1
     67:       from(2)=5
     68:       from(3)=9
     69:       from(4)=13
     70:       from(5)=3
     71:       from(6)=7
     72:       from(7)=11
     73:       from(8)=15
     74:       to(1)=0
     75:       to(2)=0
     76:       to(3)=0
     77:       to(4)=0
     78:       to(5)=7
     79:       to(6)=7
     80:       to(7)=7
     81:       to(8)=7

     83:       eight = 8
     84:       call ISCreateGeneral(PETSC_COMM_SELF,eight,from,PETSC_COPY_VALUES,      &
     85:      &                     fromis,ierr)
     86:       call ISCreateGeneral(PETSC_COMM_SELF,eight,to,PETSC_COPY_VALUES,        &
     87:      &                     tois,ierr)
     88:       call VecScatterCreate(v1,fromis,v2,tois,scat1,ierr)
     89:       call VecScatterCreate(v1,fromis,v3,tois,scat2,ierr)
     90:       call ISDestroy(fromis,ierr)
     91:       call ISDestroy(tois,ierr)

     93:       call VecScatterBegin(scat1,v1,v2,ADD_VALUES,SCATTER_FORWARD,ierr)
     94:       call VecScatterEnd(scat1,v1,v2,ADD_VALUES,SCATTER_FORWARD,ierr)

     96:       call VecScatterBegin(scat2,v1,v3,ADD_VALUES,SCATTER_FORWARD,ierr)
     97:       call VecScatterEnd(scat2,v1,v3,ADD_VALUES,SCATTER_FORWARD,ierr)

     99:       call PetscObjectSetName(v1, 'V1',ierr)
    100:       call VecView(v1,PETSC_VIEWER_STDOUT_WORLD,ierr)

    102:       call PetscObjectSetName(v2, 'V2',ierr)
    103:       call VecView(v2,PETSC_VIEWER_STDOUT_WORLD,ierr)

    105:       if (rank.eq.0) then
    106:          call PetscObjectSetName(v3, 'V3',ierr)
    107:          call VecView(v3,PETSC_VIEWER_STDOUT_SELF,ierr)
    108:       end if

    110:       call VecScatterDestroy(scat1,ierr)
    111:       call VecScatterDestroy(scat2,ierr)
    112:       call VecDestroy(v1,ierr)
    113:       call VecDestroy(v2,ierr)
    114:       call VecDestroy(v3,ierr)

    116:       call PetscFinalize(ierr)

    118:       end

    120: !/*TEST
    121: !
    122: !     test:
    123: !       nsize: 4
    124: !
    125: !TEST*/