1*c4762a1bSJed Brown! 2*c4762a1bSJed Brown! Program to test PetscSubcomm. 3*c4762a1bSJed Brown! 4*c4762a1bSJed Brown program main 5*c4762a1bSJed Brown 6*c4762a1bSJed Brown#include <petsc/finclude/petscsys.h> 7*c4762a1bSJed Brown use petscsys 8*c4762a1bSJed Brown implicit none 9*c4762a1bSJed Brown 10*c4762a1bSJed Brown PetscErrorCode ierr 11*c4762a1bSJed Brown PetscSubcomm r 12*c4762a1bSJed Brown PetscMPIInt rank,size 13*c4762a1bSJed Brown MPI_Comm scomm 14*c4762a1bSJed Brown 15*c4762a1bSJed Brown call PetscInitialize(PETSC_NULL_CHARACTER,ierr) 16*c4762a1bSJed Brown if (ierr .ne. 0) then 17*c4762a1bSJed Brown print*, 'Unable to begin PETSc program' 18*c4762a1bSJed Brown endif 19*c4762a1bSJed Brown 20*c4762a1bSJed Brown call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr) 21*c4762a1bSJed Brown! if (size .ne. 2) SETERRA(PETSC_COMM_WORLD,PETSC_ERR_ARG_SIZ,'Two ranks only') 22*c4762a1bSJed Brown call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr) 23*c4762a1bSJed Brown call PetscSubcommCreate(PETSC_COMM_WORLD,r,ierr) 24*c4762a1bSJed Brown call PetscSubcommSetFromOptions(r,ierr) 25*c4762a1bSJed Brown call PetscSubcommSetTypeGeneral(r,rank,rank,ierr) 26*c4762a1bSJed Brown 27*c4762a1bSJed Brown call PetscSubcommGetChild(r,scomm,ierr) 28*c4762a1bSJed Brown call PetscSubcommView(r,PETSC_VIEWER_STDOUT_WORLD,ierr) 29*c4762a1bSJed Brown call PetscSubcommDestroy(r,ierr) 30*c4762a1bSJed Brown call PetscFinalize(ierr) 31*c4762a1bSJed Brown end 32*c4762a1bSJed Brown 33*c4762a1bSJed Brown! 34*c4762a1bSJed Brown!/*TEST 35*c4762a1bSJed Brown! 36*c4762a1bSJed Brown! test: 37*c4762a1bSJed Brown! nsize: 2 38*c4762a1bSJed Brown! 39*c4762a1bSJed Brown!TEST*/ 40