1: static const char help[] = "Test freeing of MPI types in PetscSF\n\n";

  3: #include <petscvec.h>
  4: #include <petscsf.h>
  5: #include <petscviewer.h>

  7: int main(int argc, char **argv)
  8: {
  9:   PetscSF      sf;
 10:   Vec          A, Aout;
 11:   PetscScalar *bufA;
 12:   PetscScalar *bufAout;
 13:   PetscMPIInt  rank, size;
 14:   PetscInt     nroots, nleaves;
 15:   PetscInt    *ilocal;
 16:   PetscSFNode *iremote;
 17:   PetscBool    test_dupped_type;
 18:   MPI_Datatype contig;

 20:   PetscFunctionBeginUser;
 21:   PetscCall(PetscInitialize(&argc, &argv, NULL, help));
 22:   PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, &rank));
 23:   PetscCallMPI(MPI_Comm_size(PETSC_COMM_WORLD, &size));

 25:   PetscCheck(size == 1, PETSC_COMM_WORLD, PETSC_ERR_WRONG_MPI_SIZE, "Only coded for one MPI process");

 27:   PetscOptionsBegin(PETSC_COMM_WORLD, "", "PetscSF type freeing options", "none");
 28:   test_dupped_type = PETSC_FALSE;
 29:   PetscCall(PetscOptionsBool("-test_dupped_type", "Test dupped input type", "", test_dupped_type, &test_dupped_type, NULL));
 30:   PetscOptionsEnd();

 32:   PetscCall(PetscSFCreate(PETSC_COMM_WORLD, &sf));
 33:   PetscCall(PetscSFSetFromOptions(sf));

 35:   nleaves = 1;
 36:   nroots  = 1;
 37:   PetscCall(PetscMalloc1(nleaves, &ilocal));

 39:   for (PetscInt i = 0; i < nleaves; i++) ilocal[i] = i;

 41:   PetscCall(PetscMalloc1(nleaves, &iremote));
 42:   iremote[0].rank  = 0;
 43:   iremote[0].index = 0;
 44:   PetscCall(PetscSFSetGraph(sf, nroots, nleaves, ilocal, PETSC_OWN_POINTER, iremote, PETSC_OWN_POINTER));
 45:   PetscCall(PetscSFSetUp(sf));
 46:   PetscCall(PetscSFView(sf, PETSC_VIEWER_STDOUT_WORLD));
 47:   PetscCall(VecCreate(PETSC_COMM_WORLD, &A));
 48:   PetscCall(VecSetSizes(A, 4, PETSC_DETERMINE));
 49:   PetscCall(VecSetFromOptions(A));
 50:   PetscCall(VecSetUp(A));

 52:   PetscCall(VecDuplicate(A, &Aout));
 53:   PetscCall(VecGetArray(A, &bufA));
 54:   for (PetscInt i = 0; i < 4; i++) bufA[i] = (PetscScalar)i;
 55:   PetscCall(VecRestoreArray(A, &bufA));

 57:   PetscCall(VecGetArrayRead(A, (const PetscScalar **)&bufA));
 58:   PetscCall(VecGetArray(Aout, &bufAout));

 60:   PetscCallMPI(MPI_Type_contiguous(4, MPIU_SCALAR, &contig));
 61:   PetscCallMPI(MPI_Type_commit(&contig));

 63:   if (test_dupped_type) {
 64:     MPI_Datatype tmp;
 65:     PetscCallMPI(MPI_Type_dup(contig, &tmp));
 66:     PetscCallMPI(MPI_Type_free(&contig));
 67:     contig = tmp;
 68:   }
 69:   PetscCall(PetscSFRegisterPersistent(sf, contig, bufA, bufAout));
 70:   for (PetscInt i = 0; i < 10000; i++) {
 71:     PetscCall(PetscSFBcastBegin(sf, contig, bufA, bufAout, MPI_REPLACE));
 72:     PetscCall(PetscSFBcastEnd(sf, contig, bufA, bufAout, MPI_REPLACE));
 73:   }
 74:   PetscCall(PetscSFDeregisterPersistent(sf, contig, bufA, bufAout));
 75:   PetscCall(VecRestoreArrayRead(A, (const PetscScalar **)&bufA));
 76:   PetscCall(VecRestoreArray(Aout, &bufAout));

 78:   PetscCall(VecView(Aout, PETSC_VIEWER_STDOUT_WORLD));
 79:   PetscCall(VecDestroy(&A));
 80:   PetscCall(VecDestroy(&Aout));
 81:   PetscCall(PetscSFDestroy(&sf));
 82:   PetscCallMPI(MPI_Type_free(&contig));
 83:   PetscCall(PetscFinalize());
 84:   return 0;
 85: }

 87: /*TEST

 89:    test:
 90:       suffix: basic
 91:       args: -sf_type basic

 93:    test:
 94:       suffix: basic_dupped
 95:       args: -test_dupped_type -sf_type basic

 97:    test:
 98:       suffix: window
 99:       filter: grep -v "type" | grep -v "sort"
100:       args: -sf_type window -sf_window_sync {{fence active lock}} -sf_window_flavor {{create allocate dynamic}}
101:       requires: defined(PETSC_HAVE_MPI_ONE_SIDED) defined(PETSC_HAVE_MPI_FEATURE_DYNAMIC_WINDOW)

103:    test:
104:       suffix: window_dupped
105:       filter: grep -v "type" | grep -v "sort"
106:       args: -test_dupped_type -sf_type window -sf_window_sync {{fence active lock}} -sf_window_flavor {{create allocate dynamic}}
107:       requires: defined(PETSC_HAVE_MPI_ONE_SIDED) defined(PETSC_HAVE_MPI_FEATURE_DYNAMIC_WINDOW)

109:    test:
110:       suffix: window_shared
111:       output_file: output/ex3_window.out
112:       filter: grep -v "type" | grep -v "sort"
113:       args: -sf_type window -sf_window_sync {{fence active lock}} -sf_window_flavor shared
114:       requires: defined(PETSC_HAVE_MPI_PROCESS_SHARED_MEMORY) defined(PETSC_HAVE_MPI_ONE_SIDED) !defined(PETSC_HAVE_I_MPI)

116:    test:
117:       suffix: window_dupped_shared
118:       output_file: output/ex3_window_dupped.out
119:       filter: grep -v "type" | grep -v "sort"
120:       args: -test_dupped_type -sf_type window -sf_window_sync {{fence active lock}} -sf_window_flavor shared
121:       requires: defined(PETSC_HAVE_MPI_PROCESS_SHARED_MEMORY) defined(PETSC_HAVE_MPI_ONE_SIDED) !defined(PETSC_HAVE_I_MPI)

123: TEST*/