1! Description: A star forest is a simple tree with one root and zero or more leaves. 2! Many common communication patterns can be expressed as updates of rootdata using leafdata and vice-versa. 3! This example creates a star forest, communicates values using the graph views the graph, then destroys it. 4! 5! This is a copy of ex1.c but currently only tests the broadcast operation 6 7 program main 8#include <petsc/finclude/petscvec.h> 9 use petscmpi ! or mpi or mpi_f08 10 use petscvec 11 implicit none 12 13 PetscErrorCode ierr 14 PetscInt i,nroots,nrootsalloc,nleaves,nleavesalloc,mine(6),stride 15 type(PetscSFNode) remote(6) 16 PetscMPIInt rank,size 17 PetscSF sf 18 PetscInt rootdata(6),leafdata(6) 19 20! used with PetscSFGetGraph() 21 type(PetscSFNode), pointer :: gremote(:) 22 PetscInt, pointer :: gmine(:) 23 PetscInt gnroots,gnleaves; 24 25 PetscInt niranks,nranks 26 PetscMPIInt, pointer :: iranks(:), ranks(:) 27 PetscInt, pointer :: ioffset(:),irootloc(:),roffset(:),rmine(:),rremote(:) 28 29 PetscCallA(PetscInitialize(ierr)) 30 stride = 2 31 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)) 32 PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)) 33 34 if (rank == 0) then 35 nroots = 3 36 else 37 nroots = 2 38 endif 39 nrootsalloc = nroots * stride; 40 if (rank > 0) then 41 nleaves = 3 42 else 43 nleaves = 2 44 endif 45 nleavesalloc = nleaves * stride 46 if (stride > 1) then 47 do i=1,nleaves 48 mine(i) = stride * (i-1) 49 enddo 50 endif 51 52! Left periodic neighbor 53 remote(1)%rank = modulo(rank+size-1,size) 54 remote(1)%index = 1 * stride 55! Right periodic neighbor 56 remote(2)%rank = modulo(rank+1,size) 57 remote(2)%index = 0 * stride 58 if (rank > 0) then ! All processes reference rank 0, index 59 remote(3)%rank = 0 60 remote(3)%index = 2 * stride 61 endif 62 63! Create a star forest for communication 64 PetscCallA(PetscSFCreate(PETSC_COMM_WORLD,sf,ierr)) 65 PetscCallA(PetscSFSetFromOptions(sf,ierr)) 66 PetscCallA(PetscSFSetGraph(sf,nrootsalloc,nleaves,mine,PETSC_COPY_VALUES,remote,PETSC_COPY_VALUES,ierr)) 67 PetscCallA(PetscSFSetUp(sf,ierr)) 68 69! View graph, mostly useful for debugging purposes. 70 PetscCallA(PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO_DETAIL,ierr)) 71 PetscCallA(PetscSFView(sf,PETSC_VIEWER_STDOUT_WORLD,ierr)) 72 PetscCallA(PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD,ierr)) 73 74! Allocate space for send and receive buffers. This example communicates PetscInt, but other types, including 75! * user-defined structures, could also be used. 76! Set rootdata buffer to be broadcast 77 do i=1,nrootsalloc 78 rootdata(i) = -1 79 enddo 80 do i=1,nroots 81 rootdata(1 + (i-1)*stride) = 100*(rank+1) + i - 1 82 enddo 83 84! Initialize local buffer, these values are never used. 85 do i=1,nleavesalloc 86 leafdata(i) = -1 87 enddo 88 89! Broadcast entries from rootdata to leafdata. Computation or other communication can be performed between the begin and end calls. 90 PetscCallA(PetscSFBcastBegin(sf,MPIU_INTEGER,rootdata,leafdata,MPI_REPLACE,ierr)) 91 PetscCallA(PetscSFBcastEnd(sf,MPIU_INTEGER,rootdata,leafdata,MPI_REPLACE,ierr)) 92 PetscCallA(PetscViewerASCIIPrintf(PETSC_VIEWER_STDOUT_WORLD,'## Bcast Rootdata\n',ierr)) 93 PetscCallA(PetscIntView(nrootsalloc,rootdata,PETSC_VIEWER_STDOUT_WORLD,ierr)) 94 PetscCallA(PetscViewerASCIIPrintf(PETSC_VIEWER_STDOUT_WORLD,'## Bcast Leafdata\n',ierr)) 95 PetscCallA(PetscIntView(nleavesalloc,leafdata,PETSC_VIEWER_STDOUT_WORLD,ierr)) 96 97! Reduce entries from leafdata to rootdata. Computation or other communication can be performed between the begin and end calls. 98 PetscCallA(PetscSFReduceBegin(sf,MPIU_INTEGER,leafdata,rootdata,MPI_SUM,ierr)) 99 PetscCallA(PetscSFReduceEnd(sf,MPIU_INTEGER,leafdata,rootdata,MPI_SUM,ierr)) 100 PetscCallA(PetscViewerASCIIPrintf(PETSC_VIEWER_STDOUT_WORLD,'## Reduce Leafdata\n',ierr)) 101 PetscCallA(PetscIntView(nleavesalloc,leafdata,PETSC_VIEWER_STDOUT_WORLD,ierr)) 102 PetscCallA(PetscViewerASCIIPrintf(PETSC_VIEWER_STDOUT_WORLD,'## Reduce Rootdata\n',ierr)) 103 PetscCallA(PetscIntView(nrootsalloc,rootdata,PETSC_VIEWER_STDOUT_WORLD,ierr)) 104 105 PetscCallA(PetscSFGetGraph(sf,gnroots,gnleaves,gmine,gremote,ierr)) 106 PetscCheckA(gnleaves .eq. nleaves,PETSC_COMM_WORLD,PETSC_ERR_PLIB,'nleaves returned from PetscSFGetGraph() does not match that set with PetscSFSetGraph()') 107 do i=1,nleaves 108 PetscCheckA(gmine(i) .eq. mine(i),PETSC_COMM_WORLD,PETSC_ERR_PLIB,'Root from PetscSFGetGraph() does not match that set with PetscSFSetGraph()') 109 enddo 110 do i=1,nleaves 111 PetscCheckA(gremote(i)%index .eq. remote(i)%index,PETSC_COMM_WORLD,PETSC_ERR_PLIB,'Leaf from PetscSFGetGraph() does not match that set with PetscSFSetGraph()') 112 enddo 113 114 deallocate(gremote) 115 116! Test PetscSFGet{Leaf,Root}Ranks 117 PetscCallA(PetscSFGetLeafRanks(sf,niranks,iranks,ioffset,irootloc,ierr)) 118 PetscCallA(PetscSFGetRootRanks(sf,nranks,ranks,roffset,rmine,rremote,ierr)) 119 120! Clean storage for star forest. 121 PetscCallA(PetscSFDestroy(sf,ierr)) 122 123! Create a star forest with continuous leaves and hence no buffer 124 PetscCallA(PetscSFCreate(PETSC_COMM_WORLD,sf,ierr)) 125 PetscCallA(PetscSFSetFromOptions(sf,ierr)) 126 PetscCallA(PetscSFSetGraph(sf,nrootsalloc,nleaves,PETSC_NULL_INTEGER,PETSC_COPY_VALUES,remote,PETSC_COPY_VALUES,ierr)) 127 PetscCallA(PetscSFSetUp(sf,ierr)) 128 129! View graph, mostly useful for debugging purposes. 130 PetscCallA(PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO_DETAIL,ierr)) 131 PetscCallA(PetscSFView(sf,PETSC_VIEWER_STDOUT_WORLD,ierr)) 132 PetscCallA(PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD,ierr)) 133 134 PetscCallA(PetscSFGetGraph(sf,gnroots,gnleaves,gmine,gremote,ierr)) 135 PetscCheckA(loc(gmine) .eq. loc(PETSC_NULL_INTEGER),PETSC_COMM_WORLD,PETSC_ERR_PLIB,'Leaves from PetscSFGetGraph() not null as expected') 136 deallocate(gremote) 137 PetscCallA(PetscSFDestroy(sf,ierr)) 138 PetscCallA(PetscFinalize(ierr)) 139 end 140 141!/*TEST 142! build: 143! requires: defined(PETSC_HAVE_FORTRAN_TYPE_STAR) 144! 145! test: 146! nsize: 3 147! 148!TEST*/ 149