1 #include <petsc/private/tsimpl.h> /*I "petscts.h" I*/ 2 #include <petscdm.h> 3 static PetscErrorCode TSRHSSplitGetRHSSplit(TS ts, const char splitname[], TS_RHSSplitLink *isplit) 4 { 5 PetscBool found = PETSC_FALSE; 6 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 } 17 18 /*@C 19 TSRHSSplitSetIS - Set the index set for the specified split 20 21 Logically Collective 22 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 27 28 Level: intermediate 29 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]; 36 37 PetscFunctionBegin; 38 PetscValidHeaderSpecific(ts, TS_CLASSID, 1); 39 PetscValidHeaderSpecific(is, IS_CLASSID, 3); 40 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)); 51 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 } 63 64 /*@C 65 TSRHSSplitGetIS - Retrieves the elements for a split as an `IS` 66 67 Logically Collective 68 69 Input Parameters: 70 + ts - the `TS` context obtained from `TSCreate()` 71 - splitname - name of this split 72 73 Output Parameter: 74 . is - the index set for part of the solution vector 75 76 Level: intermediate 77 78 .seealso: [](ch_ts), `TS`, `IS`, `TSRHSSplitSetIS()` 79 @*/ 80 PetscErrorCode TSRHSSplitGetIS(TS ts, const char splitname[], IS *is) 81 { 82 TS_RHSSplitLink isplit; 83 84 PetscFunctionBegin; 85 PetscValidHeaderSpecific(ts, TS_CLASSID, 1); 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 } 92 93 /*@C 94 TSRHSSplitSetRHSFunction - Set the split right-hand-side functions. 95 96 Logically Collective 97 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`) 104 105 Level: intermediate 106 107 .seealso: [](ch_ts), `TS`, `TSRHSFunctionFn`, `IS`, `TSRHSSplitSetIS()` 108 @*/ 109 PetscErrorCode TSRHSSplitSetRHSFunction(TS ts, const char splitname[], Vec r, TSRHSFunctionFn *rhsfunc, void *ctx) 110 { 111 TS_RHSSplitLink isplit; 112 DM dmc; 113 Vec subvec, ralloc = NULL; 114 115 PetscFunctionBegin; 116 PetscValidHeaderSpecific(ts, TS_CLASSID, 1); 117 if (r) PetscValidHeaderSpecific(r, VEC_CLASSID, 3); 118 119 /* look up the split */ 120 PetscCall(TSRHSSplitGetRHSSplit(ts, splitname, &isplit)); 121 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); 122 123 if (!r && ts->vec_sol) { 124 PetscCall(VecGetSubVector(ts->vec_sol, isplit->is, &subvec)); 125 PetscCall(VecDuplicate(subvec, &ralloc)); 126 r = ralloc; 127 PetscCall(VecRestoreSubVector(ts->vec_sol, isplit->is, &subvec)); 128 } 129 130 if (ts->dm) { 131 PetscInt dim; 132 133 PetscCall(DMGetDimension(ts->dm, &dim)); 134 if (dim != -1) { 135 PetscCall(DMClone(ts->dm, &dmc)); 136 PetscCall(TSSetDM(isplit->ts, dmc)); 137 PetscCall(DMDestroy(&dmc)); 138 } 139 } 140 141 PetscCall(TSSetRHSFunction(isplit->ts, r, rhsfunc, ctx)); 142 PetscCall(VecDestroy(&ralloc)); 143 PetscFunctionReturn(PETSC_SUCCESS); 144 } 145 146 /*@C 147 TSRHSSplitGetSubTS - Get the sub-`TS` by split name. 148 149 Logically Collective 150 151 Input Parameter: 152 . ts - the `TS` context obtained from `TSCreate()` 153 154 Output Parameters: 155 + splitname - the number of the split 156 - subts - the sub-`TS` 157 158 Level: advanced 159 160 .seealso: [](ch_ts), `TS`, `IS`, `TSGetRHSSplitFunction()` 161 @*/ 162 PetscErrorCode TSRHSSplitGetSubTS(TS ts, const char splitname[], TS *subts) 163 { 164 TS_RHSSplitLink isplit; 165 166 PetscFunctionBegin; 167 PetscValidHeaderSpecific(ts, TS_CLASSID, 1); 168 PetscAssertPointer(subts, 3); 169 *subts = NULL; 170 /* look up the split */ 171 PetscCall(TSRHSSplitGetRHSSplit(ts, splitname, &isplit)); 172 if (isplit) *subts = isplit->ts; 173 PetscFunctionReturn(PETSC_SUCCESS); 174 } 175 176 /*@C 177 TSRHSSplitGetSubTSs - Get an array of all sub-`TS` contexts. 178 179 Logically Collective 180 181 Input Parameter: 182 . ts - the `TS` context obtained from `TSCreate()` 183 184 Output Parameters: 185 + n - the number of splits 186 - subts - the array of `TS` contexts 187 188 Level: advanced 189 190 Note: 191 After `TSRHSSplitGetSubTS()` the array of `TS`s is to be freed by the user with `PetscFree()` 192 (not the `TS` in the array just the array that contains them). 193 194 .seealso: [](ch_ts), `TS`, `IS`, `TSGetRHSSplitFunction()` 195 @*/ 196 PetscErrorCode TSRHSSplitGetSubTSs(TS ts, PetscInt *n, TS *subts[]) 197 { 198 TS_RHSSplitLink ilink = ts->tsrhssplit; 199 PetscInt i = 0; 200 201 PetscFunctionBegin; 202 PetscValidHeaderSpecific(ts, TS_CLASSID, 1); 203 if (subts) { 204 PetscCall(PetscMalloc1(ts->num_rhs_splits, subts)); 205 while (ilink) { 206 (*subts)[i++] = ilink->ts; 207 ilink = ilink->next; 208 } 209 } 210 if (n) *n = ts->num_rhs_splits; 211 PetscFunctionReturn(PETSC_SUCCESS); 212 } 213