Actual source code: tsrhssplit.c
1: #include <petsc/private/tsimpl.h>
2: #include <petscdm.h>
3: static PetscErrorCode TSRHSSplitGetRHSSplit(TS ts, const char splitname[], TS_RHSSplitLink *isplit)
4: {
5: PetscBool found = PETSC_FALSE;
7: PetscFunctionBegin;
8: *isplit = ts->tsrhssplit;
9: /* look up the split */
10: while (*isplit) {
11: PetscCall(PetscStrcmp((*isplit)->splitname, splitname, &found));
12: if (found) break;
13: *isplit = (*isplit)->next;
14: }
15: PetscFunctionReturn(PETSC_SUCCESS);
16: }
18: /*@C
19: TSRHSSplitSetIS - Set the index set for the specified split
21: Logically Collective
23: Input Parameters:
24: + ts - the `TS` context obtained from `TSCreate()`
25: . splitname - name of this split, if `NULL` the number of the split is used
26: - is - the index set for part of the solution vector
28: Level: intermediate
30: .seealso: [](ch_ts), `TS`, `IS`, `TSRHSSplitGetIS()`
31: @*/
32: PetscErrorCode TSRHSSplitSetIS(TS ts, const char splitname[], IS is)
33: {
34: TS_RHSSplitLink newsplit, next = ts->tsrhssplit;
35: char prefix[128];
37: PetscFunctionBegin;
41: PetscCall(PetscNew(&newsplit));
42: if (splitname) {
43: PetscCall(PetscStrallocpy(splitname, &newsplit->splitname));
44: } else {
45: PetscCall(PetscMalloc1(8, &newsplit->splitname));
46: PetscCall(PetscSNPrintf(newsplit->splitname, 7, "%" PetscInt_FMT, ts->num_rhs_splits));
47: }
48: PetscCall(PetscObjectReference((PetscObject)is));
49: newsplit->is = is;
50: PetscCall(TSCreate(PetscObjectComm((PetscObject)ts), &newsplit->ts));
52: PetscCall(PetscObjectIncrementTabLevel((PetscObject)newsplit->ts, (PetscObject)ts, 1));
53: PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "%srhsplit_%s_", ((PetscObject)ts)->prefix ? ((PetscObject)ts)->prefix : "", newsplit->splitname));
54: PetscCall(TSSetOptionsPrefix(newsplit->ts, prefix));
55: if (!next) ts->tsrhssplit = newsplit;
56: else {
57: while (next->next) next = next->next;
58: next->next = newsplit;
59: }
60: ts->num_rhs_splits++;
61: PetscFunctionReturn(PETSC_SUCCESS);
62: }
64: /*@C
65: TSRHSSplitGetIS - Retrieves the elements for a split as an `IS`
67: Logically Collective
69: Input Parameters:
70: + ts - the `TS` context obtained from `TSCreate()`
71: - splitname - name of this split
73: Output Parameter:
74: . is - the index set for part of the solution vector
76: Level: intermediate
78: .seealso: [](ch_ts), `TS`, `IS`, `TSRHSSplitSetIS()`
79: @*/
80: PetscErrorCode TSRHSSplitGetIS(TS ts, const char splitname[], IS *is)
81: {
82: TS_RHSSplitLink isplit;
84: PetscFunctionBegin;
86: *is = NULL;
87: /* look up the split */
88: PetscCall(TSRHSSplitGetRHSSplit(ts, splitname, &isplit));
89: if (isplit) *is = isplit->is;
90: PetscFunctionReturn(PETSC_SUCCESS);
91: }
93: /*@C
94: TSRHSSplitSetRHSFunction - Set the split right-hand-side functions.
96: Logically Collective
98: Input Parameters:
99: + ts - the `TS` context obtained from `TSCreate()`
100: . splitname - name of this split
101: . r - vector to hold the residual (or `NULL` to have it created internally)
102: . rhsfunc - the RHS function evaluation routine
103: - ctx - user-defined context for private data for the split function evaluation routine (may be `NULL`)
105: Calling sequence of `rhsfun`:
106: $ PetscErrorCode rhsfunc(TS ts, PetscReal t, Vec u, Vec f,ctx)
107: + ts - the `TS` context obtained from `TSCreate()`
108: . t - time at step/stage being solved
109: . u - state vector
110: . f - function vector
111: - ctx - [optional] user-defined context for matrix evaluation routine (may be `NULL`)
113: Level: intermediate
115: .seealso: [](ch_ts), `TS`, `TSRHSFunction`, `IS`, `TSRHSSplitSetIS()`
116: @*/
117: PetscErrorCode TSRHSSplitSetRHSFunction(TS ts, const char splitname[], Vec r, TSRHSFunction rhsfunc, void *ctx)
118: {
119: TS_RHSSplitLink isplit;
120: DM dmc;
121: Vec subvec, ralloc = NULL;
123: PetscFunctionBegin;
127: /* look up the split */
128: PetscCall(TSRHSSplitGetRHSSplit(ts, splitname, &isplit));
129: PetscCheck(isplit, PETSC_COMM_SELF, PETSC_ERR_USER, "The split %s is not created, check the split name or call TSRHSSplitSetIS() to create one", splitname);
131: if (!r && ts->vec_sol) {
132: PetscCall(VecGetSubVector(ts->vec_sol, isplit->is, &subvec));
133: PetscCall(VecDuplicate(subvec, &ralloc));
134: r = ralloc;
135: PetscCall(VecRestoreSubVector(ts->vec_sol, isplit->is, &subvec));
136: }
138: if (ts->dm) {
139: PetscInt dim;
141: PetscCall(DMGetDimension(ts->dm, &dim));
142: if (dim != -1) {
143: PetscCall(DMClone(ts->dm, &dmc));
144: PetscCall(TSSetDM(isplit->ts, dmc));
145: PetscCall(DMDestroy(&dmc));
146: }
147: }
149: PetscCall(TSSetRHSFunction(isplit->ts, r, rhsfunc, ctx));
150: PetscCall(VecDestroy(&ralloc));
151: PetscFunctionReturn(PETSC_SUCCESS);
152: }
154: /*@C
155: TSRHSSplitGetSubTS - Get the sub-`TS` by split name.
157: Logically Collective
159: Input Parameter:
160: . ts - the `TS` context obtained from `TSCreate()`
162: Output Parameters:
163: + splitname - the number of the split
164: - subts - the sub-`TS`
166: Level: advanced
168: .seealso: [](ch_ts), `TS`, `IS`, `TSGetRHSSplitFunction()`
169: @*/
170: PetscErrorCode TSRHSSplitGetSubTS(TS ts, const char splitname[], TS *subts)
171: {
172: TS_RHSSplitLink isplit;
174: PetscFunctionBegin;
177: *subts = NULL;
178: /* look up the split */
179: PetscCall(TSRHSSplitGetRHSSplit(ts, splitname, &isplit));
180: if (isplit) *subts = isplit->ts;
181: PetscFunctionReturn(PETSC_SUCCESS);
182: }
184: /*@C
185: TSRHSSplitGetSubTSs - Get an array of all sub-`TS` contexts.
187: Logically Collective
189: Input Parameter:
190: . ts - the `TS` context obtained from `TSCreate()`
192: Output Parameters:
193: + n - the number of splits
194: - subksp - the array of `TS` contexts
196: Level: advanced
198: Note:
199: After `TSRHSSplitGetSubTS()` the array of `TS`s is to be freed by the user with `PetscFree()`
200: (not the `TS` in the array just the array that contains them).
202: .seealso: [](ch_ts), `TS`, `IS`, `TSGetRHSSplitFunction()`
203: @*/
204: PetscErrorCode TSRHSSplitGetSubTSs(TS ts, PetscInt *n, TS *subts[])
205: {
206: TS_RHSSplitLink ilink = ts->tsrhssplit;
207: PetscInt i = 0;
209: PetscFunctionBegin;
211: if (subts) {
212: PetscCall(PetscMalloc1(ts->num_rhs_splits, subts));
213: while (ilink) {
214: (*subts)[i++] = ilink->ts;
215: ilink = ilink->next;
216: }
217: }
218: if (n) *n = ts->num_rhs_splits;
219: PetscFunctionReturn(PETSC_SUCCESS);
220: }