1 /* 2 This file contains Fortran stubs for Options routines. 3 These are not generated automatically since they require passing strings 4 between Fortran and C. 5 */ 6 7 #include <petsc/private/ftnimpl.h> 8 #include <petscviewer.h> 9 10 #if defined(PETSC_HAVE_FORTRAN_CAPS) 11 #define petscoptionsbegin_ PETSCOPTIONSBEGIN 12 #define petscoptionsend_ PETSCOPTIONSEND 13 #define petscoptionsbool_ PETSCOPTIONSBOOL 14 #define petscoptionsboolarray_ PETSCOPTIONSBOOLARRAY 15 #define petscoptionsenumprivate_ PETSCOPTIONSENUMPRIVATE 16 #define petscoptionsint_ PETSCOPTIONSINT 17 #define petscoptionsintarray_ PETSCOPTIONSINTARRAY 18 #define petscoptionsreal_ PETSCOPTIONSREAL 19 #define petscoptionsrealarray_ PETSCOPTIONSREALARRAY 20 #define petscoptionsscalar_ PETSCOPTIONSSCALAR 21 #define petscoptionsscalararray_ PETSCOPTIONSSCALARARRAY 22 #define petscoptionsstring_ PETSCOPTIONSSTRING 23 #define petscsubcommgetparent_ PETSCSUBCOMMGETPARENT 24 #define petscsubcommgetcontiguousparent_ PETSCSUBCOMMGETCONTIGUOUSPARENT 25 #define petscsubcommgetchild_ PETSCSUBCOMMGETCHILD 26 #define petscoptionsallused_ PETSCOPTIONSALLUSED 27 #define petscoptionsgetenumprivate_ PETSCOPTIONSGETENUMPRIVATE 28 #define petscoptionsgetstring_ PETSCOPTIONSGETSTRING 29 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 30 #define petscoptionsbegin_ petscoptionsbegin 31 #define petscoptionsend_ petscoptionsend 32 #define petscoptionsbool_ petscoptionsbool 33 #define petscoptionsboolarray_ petscoptionsboolarray 34 #define petscoptionsenumprivate_ petscoptionsenumprivate 35 #define petscoptionsint_ petscoptionsint 36 #define petscoptionsintarray_ petscoptionsintarray 37 #define petscoptionsreal_ petscoptionsreal 38 #define petscoptionsrealarray_ petscoptionsrealarray 39 #define petscoptionsscalar_ petscoptionsscalar 40 #define petscoptionsscalararray_ petscoptionsscalararray 41 #define petscoptionsstring_ petscoptionsstring 42 #define petscsubcommgetparent_ petscsubcommgetparent 43 #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent 44 #define petscsubcommgetchild_ petscsubcommgetchild 45 #define petscoptionsallused_ petscoptionsallused 46 #define petscoptionsgetenumprivate_ petscoptionsgetenumprivate 47 #define petscoptionsgetstring_ petscoptionsgetstring 48 #endif 49 50 static struct _n_PetscOptionItems PetscOptionsObjectBase; 51 static PetscOptionItems PetscOptionsObject = NULL; 52 53 PETSC_EXTERN void petscoptionsbegin_(MPI_Fint *fcomm, char *prefix, char *mess, char *sec, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenprefix, PETSC_FORTRAN_CHARLEN_T lenmess, PETSC_FORTRAN_CHARLEN_T lensec) 54 { 55 MPI_Comm comm = MPI_Comm_f2c(*fcomm); 56 char *cprefix, *cmess, *csec; 57 58 FIXCHAR(prefix, lenprefix, cprefix); 59 FIXCHAR(mess, lenmess, cmess); 60 FIXCHAR(sec, lensec, csec); 61 if (PetscOptionsObject) { 62 *ierr = PETSC_ERR_ARG_WRONGSTATE; 63 return; 64 } 65 PetscOptionsObject = &PetscOptionsObjectBase; 66 *ierr = PetscMemzero(PetscOptionsObject, sizeof(*PetscOptionsObject)); 67 if (*ierr) return; 68 PetscOptionsObject->count = 1; 69 *ierr = PetscOptionsBegin_Private(PetscOptionsObject, comm, cprefix, cmess, csec); 70 if (*ierr) return; 71 FREECHAR(prefix, cprefix); 72 FREECHAR(mess, cmess); 73 FREECHAR(sec, csec); 74 } 75 76 PETSC_EXTERN void petscoptionsend_(PetscErrorCode *ierr) 77 { 78 if (!PetscOptionsObject) { 79 *ierr = PETSC_ERR_ARG_WRONGSTATE; 80 return; 81 } 82 PetscOptionsObject->count = 1; 83 *ierr = PetscOptionsEnd_Private(PetscOptionsObject); 84 PetscOptionsObject = NULL; 85 } 86 87 PETSC_EXTERN void petscoptionsbool_(char *opt, char *text, char *man, PetscBool *currentvalue, PetscBool *value, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 88 { 89 char *copt, *ctext, *cman; 90 91 FIXCHAR(opt, lenopt, copt); 92 FIXCHAR(text, lentext, ctext); 93 FIXCHAR(man, lenman, cman); 94 if (!PetscOptionsObject) { 95 *ierr = PETSC_ERR_ARG_WRONGSTATE; 96 return; 97 } 98 PetscOptionsObject->count = 1; 99 *ierr = PetscOptionsBool_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set); 100 if (*ierr) return; 101 FREECHAR(opt, copt); 102 FREECHAR(text, ctext); 103 FREECHAR(man, cman); 104 } 105 106 PETSC_EXTERN void petscoptionsboolarray_(char *opt, char *text, char *man, PetscBool *dvalue, PetscInt *nmax, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 107 { 108 char *copt, *ctext, *cman; 109 PetscBool flag; 110 111 FIXCHAR(opt, lenopt, copt); 112 FIXCHAR(text, lentext, ctext); 113 FIXCHAR(man, lenman, cman); 114 if (!PetscOptionsObject) { 115 *ierr = PETSC_ERR_ARG_WRONGSTATE; 116 return; 117 } 118 PetscOptionsObject->count = 1; 119 *ierr = PetscOptionsBoolArray_Private(PetscOptionsObject, copt, ctext, cman, dvalue, nmax, &flag); 120 if (*ierr) return; 121 if (!FORTRANNULLBOOL(flg)) *flg = flag; 122 FREECHAR(opt, copt); 123 FREECHAR(text, ctext); 124 FREECHAR(man, cman); 125 } 126 127 PETSC_EXTERN void petscoptionsenumprivate_(char *opt, char *text, char *man, const char *const *list, PetscEnum *currentvalue, PetscEnum *ivalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 128 { 129 char *copt, *ctext, *cman; 130 PetscBool flag; 131 132 FIXCHAR(opt, lenopt, copt); 133 FIXCHAR(text, lentext, ctext); 134 FIXCHAR(man, lenman, cman); 135 if (!PetscOptionsObject) { 136 *ierr = PETSC_ERR_ARG_WRONGSTATE; 137 return; 138 } 139 PetscOptionsObject->count = 1; 140 *ierr = PetscOptionsEnum_Private(PetscOptionsObject, copt, ctext, cman, list, *currentvalue, ivalue, &flag); 141 if (*ierr) return; 142 if (!FORTRANNULLBOOL(flg)) *flg = flag; 143 FREECHAR(opt, copt); 144 FREECHAR(text, ctext); 145 FREECHAR(man, cman); 146 } 147 148 PETSC_EXTERN void petscoptionsint_(char *opt, char *text, char *man, PetscInt *currentvalue, PetscInt *value, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 149 { 150 char *copt, *ctext, *cman; 151 152 FIXCHAR(opt, lenopt, copt); 153 FIXCHAR(text, lentext, ctext); 154 FIXCHAR(man, lenman, cman); 155 if (!PetscOptionsObject) { 156 *ierr = PETSC_ERR_ARG_WRONGSTATE; 157 return; 158 } 159 PetscOptionsObject->count = 1; 160 *ierr = PetscOptionsInt_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_INT_MIN, PETSC_INT_MAX); 161 if (*ierr) return; 162 FREECHAR(opt, copt); 163 FREECHAR(text, ctext); 164 FREECHAR(man, cman); 165 } 166 167 PETSC_EXTERN void petscoptionsintarray_(char *opt, char *text, char *man, PetscInt *currentvalue, PetscInt *n, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 168 { 169 char *copt, *ctext, *cman; 170 171 FIXCHAR(opt, lenopt, copt); 172 FIXCHAR(text, lentext, ctext); 173 FIXCHAR(man, lenman, cman); 174 if (!PetscOptionsObject) { 175 *ierr = PETSC_ERR_ARG_WRONGSTATE; 176 return; 177 } 178 PetscOptionsObject->count = 1; 179 *ierr = PetscOptionsIntArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 180 if (*ierr) return; 181 FREECHAR(opt, copt); 182 FREECHAR(text, ctext); 183 FREECHAR(man, cman); 184 } 185 186 PETSC_EXTERN void petscoptionsreal_(char *opt, char *text, char *man, PetscReal *currentvalue, PetscReal *value, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 187 { 188 char *copt, *ctext, *cman; 189 190 FIXCHAR(opt, lenopt, copt); 191 FIXCHAR(text, lentext, ctext); 192 FIXCHAR(man, lenman, cman); 193 if (!PetscOptionsObject) { 194 *ierr = PETSC_ERR_ARG_WRONGSTATE; 195 return; 196 } 197 PetscOptionsObject->count = 1; 198 *ierr = PetscOptionsReal_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_MIN_REAL, PETSC_MAX_REAL); 199 if (*ierr) return; 200 FREECHAR(opt, copt); 201 FREECHAR(text, ctext); 202 FREECHAR(man, cman); 203 } 204 205 PETSC_EXTERN void petscoptionsrealarray_(char *opt, char *text, char *man, PetscReal *currentvalue, PetscInt *n, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 206 { 207 char *copt, *ctext, *cman; 208 209 FIXCHAR(opt, lenopt, copt); 210 FIXCHAR(text, lentext, ctext); 211 FIXCHAR(man, lenman, cman); 212 if (!PetscOptionsObject) { 213 *ierr = PETSC_ERR_ARG_WRONGSTATE; 214 return; 215 } 216 PetscOptionsObject->count = 1; 217 *ierr = PetscOptionsRealArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 218 if (*ierr) return; 219 FREECHAR(opt, copt); 220 FREECHAR(text, ctext); 221 FREECHAR(man, cman); 222 } 223 224 PETSC_EXTERN void petscoptionsscalar_(char *opt, char *text, char *man, PetscScalar *currentvalue, PetscScalar *value, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 225 { 226 char *copt, *ctext, *cman; 227 228 FIXCHAR(opt, lenopt, copt); 229 FIXCHAR(text, lentext, ctext); 230 FIXCHAR(man, lenman, cman); 231 if (!PetscOptionsObject) { 232 *ierr = PETSC_ERR_ARG_WRONGSTATE; 233 return; 234 } 235 PetscOptionsObject->count = 1; 236 *ierr = PetscOptionsScalar_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set); 237 if (*ierr) return; 238 FREECHAR(opt, copt); 239 FREECHAR(text, ctext); 240 FREECHAR(man, cman); 241 } 242 243 PETSC_EXTERN void petscoptionsscalararray_(char *opt, char *text, char *man, PetscScalar *currentvalue, PetscInt *n, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 244 { 245 char *copt, *ctext, *cman; 246 247 FIXCHAR(opt, lenopt, copt); 248 FIXCHAR(text, lentext, ctext); 249 FIXCHAR(man, lenman, cman); 250 if (!PetscOptionsObject) { 251 *ierr = PETSC_ERR_ARG_WRONGSTATE; 252 return; 253 } 254 PetscOptionsObject->count = 1; 255 *ierr = PetscOptionsScalarArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 256 if (*ierr) return; 257 FREECHAR(opt, copt); 258 FREECHAR(text, ctext); 259 FREECHAR(man, cman); 260 } 261 262 PETSC_EXTERN void petscoptionsstring_(char *opt, char *text, char *man, char *currentvalue, char *value, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman, PETSC_FORTRAN_CHARLEN_T lencurrent, PETSC_FORTRAN_CHARLEN_T lenvalue) 263 { 264 char *copt, *ctext, *cman, *ccurrent; 265 PetscBool flag; 266 267 FIXCHAR(opt, lenopt, copt); 268 FIXCHAR(text, lentext, ctext); 269 FIXCHAR(man, lenman, cman); 270 FIXCHAR(currentvalue, lencurrent, ccurrent); 271 272 if (!PetscOptionsObject) { 273 *ierr = PETSC_ERR_ARG_WRONGSTATE; 274 return; 275 } 276 PetscOptionsObject->count = 1; 277 278 *ierr = PetscOptionsString_Private(PetscOptionsObject, copt, ctext, cman, ccurrent, value, lenvalue - 1, &flag); 279 if (*ierr) return; 280 if (!FORTRANNULLBOOL(flg)) *flg = flag; 281 FREECHAR(opt, copt); 282 FREECHAR(text, ctext); 283 FREECHAR(man, cman); 284 FREECHAR(currentvalue, ccurrent); 285 FIXRETURNCHAR(flag, value, lenvalue); 286 } 287 288 PETSC_EXTERN void petscoptionsgetenumprivate_(PetscOptions *opt, char *pre, char *name, const char *const *list, PetscEnum *ivalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 289 { 290 char *c1, *c2; 291 PetscBool flag; 292 293 FIXCHAR(pre, len1, c1); 294 FIXCHAR(name, len2, c2); 295 *ierr = PetscOptionsGetEnum(*opt, c1, c2, list, ivalue, &flag); 296 if (*ierr) return; 297 if (!FORTRANNULLBOOL(flg)) *flg = flag; 298 FREECHAR(pre, c1); 299 FREECHAR(name, c2); 300 } 301 302 PETSC_EXTERN void petscoptionsgetstring_(PetscOptions *options, char *pre, char *name, char *string, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2, PETSC_FORTRAN_CHARLEN_T len) 303 { 304 char *c1, *c2, *c3; 305 size_t len3; 306 PetscBool flag; 307 308 FIXCHAR(pre, len1, c1); 309 FIXCHAR(name, len2, c2); 310 c3 = string; 311 len3 = len - 1; 312 313 *ierr = PetscOptionsGetString(*options, c1, c2, c3, len3, &flag); 314 if (*ierr) return; 315 if (!FORTRANNULLBOOL(flg)) *flg = flag; 316 FREECHAR(pre, c1); 317 FREECHAR(name, c2); 318 FIXRETURNCHAR(flag, string, len); 319 } 320 PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr) 321 { 322 MPI_Comm tcomm; 323 324 *ierr = PetscSubcommGetParent(*scomm, &tcomm); 325 *pcomm = MPI_Comm_c2f(tcomm); 326 } 327 328 PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr) 329 { 330 MPI_Comm tcomm; 331 332 *ierr = PetscSubcommGetContiguousParent(*scomm, &tcomm); 333 *pcomm = MPI_Comm_c2f(tcomm); 334 } 335 336 PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm, MPI_Fint *ccomm, int *ierr) 337 { 338 MPI_Comm tcomm; 339 340 *ierr = PetscSubcommGetChild(*scomm, &tcomm); 341 *ccomm = MPI_Comm_c2f(tcomm); 342 } 343