xref: /petsc/src/sys/utils/psplit.c (revision d18748622689843e8c5ce717aabfcc708e80ab43)
1 
2 #include <petscsys.h> /*I    "petscsys.h" I*/
3 
4 /*@
5     PetscSplitOwnershipBlock - Given a global (or local) length determines a local
6         (or global) length via a simple formula. Splits so each processors local size
7         is divisible by the block size.
8 
9    Collective (if N is `PETSC_DECIDE`)
10 
11    Input Parameters:
12 +    comm - MPI communicator that shares the object being divided
13 .    bs - block size
14 .    n - local length (or `PETSC_DECIDE` to have it set)
15 -    N - global length (or `PETSC_DECIDE`)
16 
17   Level: developer
18 
19    Notes:
20      n and N cannot be both `PETSC_DECIDE`
21 
22      If one processor calls this with N of `PETSC_DECIDE` then all processors
23      must, otherwise the program will hang.
24 
25 .seealso: `PetscSplitOwnership()`, `PetscSplitOwnershipEqual()`
26 @*/
27 PetscErrorCode PetscSplitOwnershipBlock(MPI_Comm comm, PetscInt bs, PetscInt *n, PetscInt *N) {
28   PetscMPIInt size, rank;
29 
30   PetscFunctionBegin;
31   PetscCheck(*N != PETSC_DECIDE || *n != PETSC_DECIDE, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Both n and N cannot be PETSC_DECIDE");
32 
33   if (*N == PETSC_DECIDE) {
34     PetscCheck(*n % bs == 0, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "local size %" PetscInt_FMT " not divisible by block size %" PetscInt_FMT, *n, bs);
35     PetscCall(MPIU_Allreduce(n, N, 1, MPIU_INT, MPI_SUM, comm));
36   } else if (*n == PETSC_DECIDE) {
37     PetscInt Nbs = *N / bs;
38     PetscCallMPI(MPI_Comm_size(comm, &size));
39     PetscCallMPI(MPI_Comm_rank(comm, &rank));
40     *n = bs * (Nbs / size + ((Nbs % size) > rank));
41   }
42   PetscFunctionReturn(0);
43 }
44 
45 /*@
46     PetscSplitOwnership - Given a global (or local) length determines a local
47         (or global) length via a simple formula
48 
49    Collective (if n or N is `PETSC_DECIDE`)
50 
51    Input Parameters:
52 +    comm - MPI communicator that shares the object being divided
53 .    n - local length (or `PETSC_DECIDE` to have it set)
54 -    N - global length (or `PETSC_DECIDE`)
55 
56   Level: developer
57 
58    Notes:
59      n and N cannot be both `PETSC_DECIDE`
60 
61      If one processor calls this with n or N of `PETSC_DECIDE` then all processors
62      must. Otherwise, an error is thrown in debug mode while the program will hang
63      in optimized (i.e. configured --with-debugging=0) mode.
64 
65 .seealso: `PetscSplitOwnershipBlock()`, `PetscSplitOwnershipEqual()`
66 @*/
67 PetscErrorCode PetscSplitOwnership(MPI_Comm comm, PetscInt *n, PetscInt *N) {
68   PetscMPIInt size, rank;
69 
70   PetscFunctionBegin;
71   PetscCheck(*N != PETSC_DECIDE || *n != PETSC_DECIDE, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Both n and N cannot be PETSC_DECIDE\n  likely a call to VecSetSizes() or MatSetSizes() is wrong.\nSee https://petsc.org/release/faq/#split-ownership");
72   if (PetscDefined(USE_DEBUG)) {
73     PetscMPIInt l[2], g[2];
74     l[0] = (*n == PETSC_DECIDE) ? 1 : 0;
75     l[1] = (*N == PETSC_DECIDE) ? 1 : 0;
76     PetscCallMPI(MPI_Comm_size(comm, &size));
77     PetscCall(MPIU_Allreduce(l, g, 2, MPI_INT, MPI_SUM, comm));
78     PetscCheck(!g[0] || g[0] == size, comm, PETSC_ERR_ARG_INCOMP, "All processes must supply PETSC_DECIDE for local size");
79     PetscCheck(!g[1] || g[1] == size, comm, PETSC_ERR_ARG_INCOMP, "All processes must supply PETSC_DECIDE for global size");
80   }
81 
82   if (*N == PETSC_DECIDE) {
83     PetscInt64 m = *n, M;
84     PetscCall(MPIU_Allreduce(&m, &M, 1, MPIU_INT64, MPI_SUM, comm));
85     PetscCheck(M <= PETSC_MAX_INT, comm, PETSC_ERR_INT_OVERFLOW, "Global size overflow %" PetscInt64_FMT ". You may consider ./configure PETSc with --with-64-bit-indices for the case you are running", M);
86     *N = (PetscInt)M;
87   } else if (*n == PETSC_DECIDE) {
88     PetscCallMPI(MPI_Comm_size(comm, &size));
89     PetscCallMPI(MPI_Comm_rank(comm, &rank));
90     *n = *N / size + ((*N % size) > rank);
91   } else if (PetscDefined(USE_DEBUG)) {
92     PetscInt tmp;
93     PetscCall(MPIU_Allreduce(n, &tmp, 1, MPIU_INT, MPI_SUM, comm));
94     PetscCheck(tmp == *N, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Sum of local lengths %" PetscInt_FMT " does not equal global length %" PetscInt_FMT ", my local length %" PetscInt_FMT "\n  likely a call to VecSetSizes() or MatSetSizes() is wrong.\nSee https://petsc.org/release/faq/#split-ownership", tmp, *N, *n);
95   }
96   PetscFunctionReturn(0);
97 }
98 
99 /*@
100     PetscSplitOwnershipEqual - Given a global (or local) length determines a local
101         (or global) length via a simple formula, trying to have all local lengths equal
102 
103    Collective (if n or N is `PETSC_DECIDE`)
104 
105    Input Parameters:
106 +    comm - MPI communicator that shares the object being divided
107 .    n - local length (or `PETSC_DECIDE` to have it set)
108 -    N - global length (or `PETSC_DECIDE`)
109 
110    Level: developer
111 
112    Notes:
113      This is intended to be used with `MATSCALAPACK`, where the local size must
114      be equal in all processes (except possibly the last one). For instance,
115      the local sizes when spliting N=50 with 6 processes are 9,9,9,9,9,5
116 
117      n and N cannot be both `PETSC_DECIDE`
118 
119      If one processor calls this with n or N of `PETSC_DECIDE` then all processors
120      must. Otherwise, an error is thrown in debug mode while the program will hang
121      in optimized (i.e. configured --with-debugging=0) mode.
122 
123 .seealso: `PetscSplitOwnership()`, `PetscSplitOwnershipBlock()`
124 @*/
125 PetscErrorCode PetscSplitOwnershipEqual(MPI_Comm comm, PetscInt *n, PetscInt *N) {
126   PetscMPIInt size, rank;
127 
128   PetscFunctionBegin;
129   PetscCheck(*N != PETSC_DECIDE || *n != PETSC_DECIDE, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Both n and N cannot be PETSC_DECIDE");
130   if (PetscDefined(USE_DEBUG)) {
131     PetscMPIInt l[2], g[2];
132     l[0] = (*n == PETSC_DECIDE) ? 1 : 0;
133     l[1] = (*N == PETSC_DECIDE) ? 1 : 0;
134     PetscCallMPI(MPI_Comm_size(comm, &size));
135     PetscCall(MPIU_Allreduce(l, g, 2, MPI_INT, MPI_SUM, comm));
136     PetscCheck(!g[0] || g[0] == size, comm, PETSC_ERR_ARG_INCOMP, "All processes must supply PETSC_DECIDE for local size");
137     PetscCheck(!g[1] || g[1] == size, comm, PETSC_ERR_ARG_INCOMP, "All processes must supply PETSC_DECIDE for global size");
138   }
139 
140   if (*N == PETSC_DECIDE) {
141     PetscInt64 m = *n, M;
142     PetscCall(MPIU_Allreduce(&m, &M, 1, MPIU_INT64, MPI_SUM, comm));
143     PetscCheck(M <= PETSC_MAX_INT, comm, PETSC_ERR_INT_OVERFLOW, "Global size overflow %" PetscInt64_FMT ". You may consider ./configure PETSc with --with-64-bit-indices for the case you are running", M);
144     *N = (PetscInt)M;
145   } else if (*n == PETSC_DECIDE) {
146     PetscCallMPI(MPI_Comm_size(comm, &size));
147     PetscCallMPI(MPI_Comm_rank(comm, &rank));
148     *n = *N / size;
149     if (*N % size) {
150       if ((rank + 1) * (*n + 1) <= *N) *n = *n + 1;
151       else if (rank * (*n + 1) <= *N) *n = *N - rank * (*n + 1);
152       else *n = 0;
153     }
154   } else if (PetscDefined(USE_DEBUG)) {
155     PetscInt tmp;
156     PetscCall(MPIU_Allreduce(n, &tmp, 1, MPIU_INT, MPI_SUM, comm));
157     PetscCheck(tmp == *N, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Sum of local lengths %" PetscInt_FMT " does not equal global length %" PetscInt_FMT ", my local length %" PetscInt_FMT, tmp, *N, *n);
158   }
159   PetscFunctionReturn(0);
160 }
161