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