1 // Copyright (c) 2017-2018, Lawrence Livermore National Security, LLC. 2 // Produced at the Lawrence Livermore National Laboratory. LLNL-CODE-734707. 3 // All Rights reserved. See files LICENSE and NOTICE for details. 4 // 5 // This file is part of CEED, a collection of benchmarks, miniapps, software 6 // libraries and APIs for efficient high-order finite element and spectral 7 // element discretizations for exascale applications. For more information and 8 // source code availability see http://github.com/ceed. 9 // 10 // The CEED research is supported by the Exascale Computing Project 17-SC-20-SC, 11 // a collaborative effort of two U.S. Department of Energy organizations (Office 12 // of Science and the National Nuclear Security Administration) responsible for 13 // the planning and preparation of a capable exascale ecosystem, including 14 // software, applications, hardware, advanced system engineering and early 15 // testbed platforms, in support of the nation's exascale computing imperative. 16 17 // Fortran interface 18 #include <ceed.h> 19 #include <ceed-impl.h> 20 #include <ceed-backend.h> 21 #include <ceed-fortran-name.h> 22 #include <stdlib.h> 23 #include <string.h> 24 25 #define FORTRAN_REQUEST_IMMEDIATE -1 26 #define FORTRAN_REQUEST_ORDERED -2 27 #define FORTRAN_NULL -3 28 #define FORTRAN_STRIDES_BACKEND -4 29 #define FORTRAN_VECTOR_ACTIVE -5 30 #define FORTRAN_VECTOR_NONE -6 31 #define FORTRAN_ELEMRESTRICTION_NONE -7 32 #define FORTRAN_BASIS_COLLOCATED -8 33 #define FORTRAN_QFUNCTION_NONE -9 34 35 static Ceed *Ceed_dict = NULL; 36 static int Ceed_count = 0; 37 static int Ceed_n = 0; 38 static int Ceed_count_max = 0; 39 40 // This test should actually be for the gfortran version, but we don't currently 41 // have a configure system to determine that (TODO). At present, this will use 42 // the smaller integer when run with clang+gfortran=8, for example. (That is 43 // sketchy, but will likely work for users that don't have huge character 44 // strings.) 45 #if __GNUC__ >= 8 46 typedef size_t fortran_charlen_t; 47 #else 48 typedef int fortran_charlen_t; 49 #endif 50 51 #define Splice(a, b) a ## b 52 53 // Fortran strings are generally unterminated and the length is passed as an 54 // extra argument after all the normal arguments. Some compilers (I only know 55 // of Windows) place the length argument immediately after the string parameter 56 // (TODO). 57 // 58 // We can't just NULL-terminate the string in-place because that could overwrite 59 // other strings or attempt to write to read-only memory. This macro allocates 60 // a string to hold the null-terminated version of the string that C expects. 61 #define FIX_STRING(stringname) \ 62 char Splice(stringname, _c)[1024]; \ 63 if (Splice(stringname, _len) > 1023) \ 64 CeedError(NULL, 1, "Fortran string length too long %zd", (size_t)Splice(stringname, _len)); \ 65 strncpy(Splice(stringname, _c), stringname, Splice(stringname, _len)); \ 66 Splice(stringname, _c)[Splice(stringname, _len)] = 0; \ 67 68 // ----------------------------------------------------------------------------- 69 // Ceed 70 // ----------------------------------------------------------------------------- 71 #define fCeedInit FORTRAN_NAME(ceedinit,CEEDINIT) 72 void fCeedInit(const char *resource, int *ceed, int *err, 73 fortran_charlen_t resource_len) { 74 FIX_STRING(resource); 75 if (Ceed_count == Ceed_count_max) { 76 Ceed_count_max += Ceed_count_max/2 + 1; 77 CeedRealloc(Ceed_count_max, &Ceed_dict); 78 } 79 80 Ceed *ceed_ = &Ceed_dict[Ceed_count]; 81 *err = CeedInit(resource_c, ceed_); 82 83 if (*err == 0) { 84 *ceed = Ceed_count++; 85 Ceed_n++; 86 } 87 } 88 89 #define fCeedIsDeterministic \ 90 FORTRAN_NAME(ceedisdeterministic,CEEDISDETERMINISTIC) 91 void fCeedIsDeterministic(int *ceed, int *isDeterministic, int *err) { 92 *err = CeedIsDeterministic(Ceed_dict[*ceed], (bool *)isDeterministic); 93 } 94 95 #define fCeedGetPreferredMemType \ 96 FORTRAN_NAME(ceedgetpreferredmemtype,CEEDGETPREFERREDMEMTYPE) 97 void fCeedGetPreferredMemType(int *ceed, int *type, int *err) { 98 *err = CeedGetPreferredMemType(Ceed_dict[*ceed], (CeedMemType *)type); 99 } 100 101 #define fCeedView FORTRAN_NAME(ceedview,CEEDVIEW) 102 void fCeedView(int *ceed, int *err) { 103 *err = CeedView(Ceed_dict[*ceed], stdout); 104 } 105 106 #define fCeedDestroy FORTRAN_NAME(ceeddestroy,CEEDDESTROY) 107 void fCeedDestroy(int *ceed, int *err) { 108 if (Ceed_n == 0 || !Ceed_dict[*ceed]) return; 109 *err = CeedDestroy(&Ceed_dict[*ceed]); 110 111 if (*err == 0) { 112 Ceed_n--; 113 if (Ceed_n == 0) { 114 CeedFree(&Ceed_dict); 115 Ceed_count = 0; 116 Ceed_count_max = 0; 117 } 118 } 119 } 120 121 // ----------------------------------------------------------------------------- 122 // CeedVector 123 // ----------------------------------------------------------------------------- 124 static CeedVector *CeedVector_dict = NULL; 125 static int CeedVector_count = 0; 126 static int CeedVector_n = 0; 127 static int CeedVector_count_max = 0; 128 129 #define fCeedVectorCreate FORTRAN_NAME(ceedvectorcreate,CEEDVECTORCREATE) 130 void fCeedVectorCreate(int *ceed, int *length, int *vec, int *err) { 131 if (CeedVector_count == CeedVector_count_max) { 132 CeedVector_count_max += CeedVector_count_max/2 + 1; 133 CeedRealloc(CeedVector_count_max, &CeedVector_dict); 134 } 135 136 CeedVector *vec_ = &CeedVector_dict[CeedVector_count]; 137 *err = CeedVectorCreate(Ceed_dict[*ceed], *length, vec_); 138 139 if (*err == 0) { 140 *vec = CeedVector_count++; 141 CeedVector_n++; 142 } 143 } 144 145 #define fCeedVectorSetArray FORTRAN_NAME(ceedvectorsetarray,CEEDVECTORSETARRAY) 146 void fCeedVectorSetArray(int *vec, int *memtype, int *copymode, 147 CeedScalar *array, int64_t *offset, int *err) { 148 *err = CeedVectorSetArray(CeedVector_dict[*vec], (CeedMemType)*memtype, 149 (CeedCopyMode)*copymode, 150 (CeedScalar *)(array + *offset)); 151 } 152 153 #define fCeedVectorTakeArray FORTRAN_NAME(ceedvectortakearray,CEEDVECTORTAKEARRAY) 154 void fCeedVectorTakeArray(int *vec, int *memtype, CeedScalar *array, 155 int64_t *offset, int *err) { 156 CeedScalar *b; 157 CeedVector vec_ = CeedVector_dict[*vec]; 158 *err = CeedVectorTakeArray(vec_, (CeedMemType)*memtype, &b); 159 *offset = b - array; 160 } 161 162 #define fCeedVectorSyncArray FORTRAN_NAME(ceedvectorsyncarray,CEEDVECTORSYNCARRAY) 163 void fCeedVectorSyncArray(int *vec, int *memtype, int *err) { 164 *err = CeedVectorSyncArray(CeedVector_dict[*vec], (CeedMemType)*memtype); 165 } 166 167 #define fCeedVectorSetValue FORTRAN_NAME(ceedvectorsetvalue,CEEDVECTORSETVALUE) 168 void fCeedVectorSetValue(int *vec, CeedScalar *value, int *err) { 169 *err = CeedVectorSetValue(CeedVector_dict[*vec], *value); 170 } 171 172 #define fCeedVectorGetArray FORTRAN_NAME(ceedvectorgetarray,CEEDVECTORGETARRAY) 173 void fCeedVectorGetArray(int *vec, int *memtype, CeedScalar *array, 174 int64_t *offset, int *err) { 175 CeedScalar *b; 176 CeedVector vec_ = CeedVector_dict[*vec]; 177 *err = CeedVectorGetArray(vec_, (CeedMemType)*memtype, &b); 178 *offset = b - array; 179 } 180 181 #define fCeedVectorGetArrayRead \ 182 FORTRAN_NAME(ceedvectorgetarrayread,CEEDVECTORGETARRAYREAD) 183 void fCeedVectorGetArrayRead(int *vec, int *memtype, CeedScalar *array, 184 int64_t *offset, int *err) { 185 const CeedScalar *b; 186 CeedVector vec_ = CeedVector_dict[*vec]; 187 *err = CeedVectorGetArrayRead(vec_, (CeedMemType)*memtype, &b); 188 *offset = b - array; 189 } 190 191 #define fCeedVectorRestoreArray \ 192 FORTRAN_NAME(ceedvectorrestorearray,CEEDVECTORRESTOREARRAY) 193 void fCeedVectorRestoreArray(int *vec, CeedScalar *array, 194 int64_t *offset, int *err) { 195 *err = CeedVectorRestoreArray(CeedVector_dict[*vec], &array); 196 *offset = 0; 197 } 198 199 #define fCeedVectorRestoreArrayRead \ 200 FORTRAN_NAME(ceedvectorrestorearrayread,CEEDVECTORRESTOREARRAYREAD) 201 void fCeedVectorRestoreArrayRead(int *vec, const CeedScalar *array, 202 int64_t *offset, int *err) { 203 *err = CeedVectorRestoreArrayRead(CeedVector_dict[*vec], &array); 204 *offset = 0; 205 } 206 207 #define fCeedVectorNorm \ 208 FORTRAN_NAME(ceedvectornorm,CEEDVECTORNORM) 209 void fCeedVectorNorm(int *vec, int *type, CeedScalar *norm, int *err) { 210 *err = CeedVectorNorm(CeedVector_dict[*vec], (CeedNormType)*type, norm); 211 } 212 213 #define fCeedVectorView FORTRAN_NAME(ceedvectorview,CEEDVECTORVIEW) 214 void fCeedVectorView(int *vec, int *err) { 215 *err = CeedVectorView(CeedVector_dict[*vec], "%12.8f", stdout); 216 } 217 218 #define fCeedVectorDestroy FORTRAN_NAME(ceedvectordestroy,CEEDVECTORDESTROY) 219 void fCeedVectorDestroy(int *vec, int *err) { 220 if (CeedVector_n == 0 || !CeedVector_dict[*vec]) return; 221 *err = CeedVectorDestroy(&CeedVector_dict[*vec]); 222 223 if (*err == 0) { 224 CeedVector_n--; 225 if (CeedVector_n == 0) { 226 CeedFree(&CeedVector_dict); 227 CeedVector_count = 0; 228 CeedVector_count_max = 0; 229 } 230 } 231 } 232 233 // ----------------------------------------------------------------------------- 234 // CeedElemRestriction 235 // ----------------------------------------------------------------------------- 236 static CeedElemRestriction *CeedElemRestriction_dict = NULL; 237 static int CeedElemRestriction_count = 0; 238 static int CeedElemRestriction_n = 0; 239 static int CeedElemRestriction_count_max = 0; 240 241 #define fCeedElemRestrictionCreate \ 242 FORTRAN_NAME(ceedelemrestrictioncreate, CEEDELEMRESTRICTIONCREATE) 243 void fCeedElemRestrictionCreate(int *ceed, int *nelements, int *esize, 244 int *ncomp, int *compstride, int *lsize, 245 int *memtype, int *copymode, const int *offsets, 246 int *elemrestriction, int *err) { 247 if (CeedElemRestriction_count == CeedElemRestriction_count_max) { 248 CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1; 249 CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict); 250 } 251 252 const int *offsets_ = offsets; 253 254 CeedElemRestriction *elemrestriction_ = 255 &CeedElemRestriction_dict[CeedElemRestriction_count]; 256 *err = CeedElemRestrictionCreate(Ceed_dict[*ceed], *nelements, *esize, 257 *ncomp, *compstride, *lsize, 258 (CeedMemType)*memtype, 259 (CeedCopyMode)*copymode, offsets_, 260 elemrestriction_); 261 262 if (*err == 0) { 263 *elemrestriction = CeedElemRestriction_count++; 264 CeedElemRestriction_n++; 265 } 266 } 267 268 #define fCeedElemRestrictionCreateStrided \ 269 FORTRAN_NAME(ceedelemrestrictioncreatestrided, CEEDELEMRESTRICTIONCREATESTRIDED) 270 void fCeedElemRestrictionCreateStrided(int *ceed, int *nelements, int *esize, 271 int *ncomp, int *lsize, int *strides, 272 int *elemrestriction, int *err) { 273 if (CeedElemRestriction_count == CeedElemRestriction_count_max) { 274 CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1; 275 CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict); 276 } 277 278 CeedElemRestriction *elemrestriction_ = 279 &CeedElemRestriction_dict[CeedElemRestriction_count]; 280 *err = CeedElemRestrictionCreateStrided(Ceed_dict[*ceed], *nelements, *esize, 281 *ncomp, *lsize, 282 *strides == FORTRAN_STRIDES_BACKEND ? 283 CEED_STRIDES_BACKEND : strides, 284 elemrestriction_); 285 if (*err == 0) { 286 *elemrestriction = CeedElemRestriction_count++; 287 CeedElemRestriction_n++; 288 } 289 } 290 291 #define fCeedElemRestrictionCreateBlocked \ 292 FORTRAN_NAME(ceedelemrestrictioncreateblocked,CEEDELEMRESTRICTIONCREATEBLOCKED) 293 void fCeedElemRestrictionCreateBlocked(int *ceed, int *nelements, int *esize, 294 int *blocksize, int *ncomp, 295 int *compstride, int *lsize, 296 int *mtype, int *cmode, 297 int *blkindices, int *elemrestriction, 298 int *err) { 299 300 if (CeedElemRestriction_count == CeedElemRestriction_count_max) { 301 CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1; 302 CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict); 303 } 304 305 CeedElemRestriction *elemrestriction_ = 306 &CeedElemRestriction_dict[CeedElemRestriction_count]; 307 *err = CeedElemRestrictionCreateBlocked(Ceed_dict[*ceed], 308 *nelements, *esize, *blocksize, 309 *ncomp, *compstride, *lsize, 310 (CeedMemType)*mtype, 311 (CeedCopyMode)*cmode, blkindices, 312 elemrestriction_); 313 314 if (*err == 0) { 315 *elemrestriction = CeedElemRestriction_count++; 316 CeedElemRestriction_n++; 317 } 318 } 319 320 #define fCeedElemRestrictionCreateBlockedStrided \ 321 FORTRAN_NAME(ceedelemrestrictioncreateblockedstrided, CEEDELEMRESTRICTIONCREATEBLOCKEDSTRIDED) 322 void fCeedElemRestrictionCreateBlockedStrided(int *ceed, int *nelements, 323 int *esize, int *blksize, int *ncomp, int *lsize, int *strides, 324 int *elemrestriction, int *err) { 325 if (CeedElemRestriction_count == CeedElemRestriction_count_max) { 326 CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1; 327 CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict); 328 } 329 330 CeedElemRestriction *elemrestriction_ = 331 &CeedElemRestriction_dict[CeedElemRestriction_count]; 332 *err = CeedElemRestrictionCreateBlockedStrided(Ceed_dict[*ceed], *nelements, 333 *esize, *blksize, *ncomp, *lsize, strides, elemrestriction_); 334 if (*err == 0) { 335 *elemrestriction = CeedElemRestriction_count++; 336 CeedElemRestriction_n++; 337 } 338 } 339 340 static CeedRequest *CeedRequest_dict = NULL; 341 static int CeedRequest_count = 0; 342 static int CeedRequest_n = 0; 343 static int CeedRequest_count_max = 0; 344 345 #define fCeedElemRestrictionApply \ 346 FORTRAN_NAME(ceedelemrestrictionapply,CEEDELEMRESTRICTIONAPPLY) 347 void fCeedElemRestrictionApply(int *elemr, int *tmode, int *uvec, int *ruvec, 348 int *rqst, int *err) { 349 int createRequest = 1; 350 // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1) 351 if (*rqst == FORTRAN_REQUEST_IMMEDIATE || *rqst == FORTRAN_REQUEST_ORDERED) 352 createRequest = 0; 353 354 if (createRequest && CeedRequest_count == CeedRequest_count_max) { 355 CeedRequest_count_max += CeedRequest_count_max/2 + 1; 356 CeedRealloc(CeedRequest_count_max, &CeedRequest_dict); 357 } 358 359 CeedRequest *rqst_; 360 if (*rqst == FORTRAN_REQUEST_IMMEDIATE) rqst_ = CEED_REQUEST_IMMEDIATE; 361 else if (*rqst == FORTRAN_REQUEST_ORDERED ) rqst_ = CEED_REQUEST_ORDERED; 362 else rqst_ = &CeedRequest_dict[CeedRequest_count]; 363 364 *err = CeedElemRestrictionApply(CeedElemRestriction_dict[*elemr], 365 (CeedTransposeMode)*tmode, 366 CeedVector_dict[*uvec], 367 CeedVector_dict[*ruvec], rqst_); 368 369 if (*err == 0 && createRequest) { 370 *rqst = CeedRequest_count++; 371 CeedRequest_n++; 372 } 373 } 374 375 #define fCeedElemRestrictionApplyBlock \ 376 FORTRAN_NAME(ceedelemrestrictionapplyblock,CEEDELEMRESTRICTIONAPPLYBLOCK) 377 void fCeedElemRestrictionApplyBlock(int *elemr, int *block, int *tmode, 378 int *uvec, int *ruvec, int *rqst, int *err) { 379 int createRequest = 1; 380 // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1) 381 if (*rqst == FORTRAN_REQUEST_IMMEDIATE || *rqst == FORTRAN_REQUEST_ORDERED) 382 createRequest = 0; 383 384 if (createRequest && CeedRequest_count == CeedRequest_count_max) { 385 CeedRequest_count_max += CeedRequest_count_max/2 + 1; 386 CeedRealloc(CeedRequest_count_max, &CeedRequest_dict); 387 } 388 389 CeedRequest *rqst_; 390 if (*rqst == FORTRAN_REQUEST_IMMEDIATE) rqst_ = CEED_REQUEST_IMMEDIATE; 391 else if (*rqst == FORTRAN_REQUEST_ORDERED ) rqst_ = CEED_REQUEST_ORDERED; 392 else rqst_ = &CeedRequest_dict[CeedRequest_count]; 393 394 *err = CeedElemRestrictionApplyBlock(CeedElemRestriction_dict[*elemr], *block, 395 (CeedTransposeMode)*tmode, CeedVector_dict[*uvec], 396 CeedVector_dict[*ruvec], rqst_); 397 398 if (*err == 0 && createRequest) { 399 *rqst = CeedRequest_count++; 400 CeedRequest_n++; 401 } 402 } 403 404 #define fCeedElemRestrictionGetMultiplicity \ 405 FORTRAN_NAME(ceedelemrestrictiongetmultiplicity,CEEDELEMRESTRICTIONGETMULTIPLICITY) 406 void fCeedElemRestrictionGetMultiplicity(int *elemr, int *mult, int *err) { 407 *err = CeedElemRestrictionGetMultiplicity(CeedElemRestriction_dict[*elemr], 408 CeedVector_dict[*mult]); 409 } 410 411 #define fCeedElemRestrictionGetELayout \ 412 FORTRAN_NAME(ceedelemrestrictiongetelayout,CEEDELEMRESTRICTIONGETELAYOUT) 413 void fCeedElemRestrictionGetELayout(int *elemr, int *layout, int *err) { 414 CeedInt layout_c[3]; 415 *err = CeedElemRestrictionGetELayout(CeedElemRestriction_dict[*elemr], 416 &layout_c); 417 for (int i=0; i<3; i++) 418 layout[i] = layout_c[i]; 419 } 420 421 #define fCeedElemRestrictionView \ 422 FORTRAN_NAME(ceedelemrestrictionview,CEEDELEMRESTRICTIONVIEW) 423 void fCeedElemRestrictionView(int *elemr, int *err) { 424 *err = CeedElemRestrictionView(CeedElemRestriction_dict[*elemr], stdout); 425 } 426 427 #define fCeedRequestWait FORTRAN_NAME(ceedrequestwait, CEEDREQUESTWAIT) 428 void fCeedRequestWait(int *rqst, int *err) { 429 // TODO Uncomment this once CeedRequestWait is implemented 430 //*err = CeedRequestWait(&CeedRequest_dict[*rqst]); 431 432 if (*err == 0) { 433 CeedRequest_n--; 434 if (CeedRequest_n == 0) { 435 CeedFree(&CeedRequest_dict); 436 CeedRequest_count = 0; 437 CeedRequest_count_max = 0; 438 } 439 } 440 } 441 442 #define fCeedElemRestrictionDestroy \ 443 FORTRAN_NAME(ceedelemrestrictiondestroy,CEEDELEMRESTRICTIONDESTROY) 444 void fCeedElemRestrictionDestroy(int *elem, int *err) { 445 if (CeedElemRestriction_n == 0 || !CeedElemRestriction_dict[*elem]) return; 446 *err = CeedElemRestrictionDestroy(&CeedElemRestriction_dict[*elem]); 447 448 if (*err == 0) { 449 CeedElemRestriction_n--; 450 if (CeedElemRestriction_n == 0) { 451 CeedFree(&CeedElemRestriction_dict); 452 CeedElemRestriction_count = 0; 453 CeedElemRestriction_count_max = 0; 454 } 455 } 456 } 457 458 // ----------------------------------------------------------------------------- 459 // CeedBasis 460 // ----------------------------------------------------------------------------- 461 static CeedBasis *CeedBasis_dict = NULL; 462 static int CeedBasis_count = 0; 463 static int CeedBasis_n = 0; 464 static int CeedBasis_count_max = 0; 465 466 #define fCeedBasisCreateTensorH1Lagrange \ 467 FORTRAN_NAME(ceedbasiscreatetensorh1lagrange, CEEDBASISCREATETENSORH1LAGRANGE) 468 void fCeedBasisCreateTensorH1Lagrange(int *ceed, int *dim, 469 int *ncomp, int *P, int *Q, int *quadmode, 470 int *basis, int *err) { 471 if (CeedBasis_count == CeedBasis_count_max) { 472 CeedBasis_count_max += CeedBasis_count_max/2 + 1; 473 CeedRealloc(CeedBasis_count_max, &CeedBasis_dict); 474 } 475 476 *err = CeedBasisCreateTensorH1Lagrange(Ceed_dict[*ceed], *dim, *ncomp, *P, *Q, 477 (CeedQuadMode)*quadmode, 478 &CeedBasis_dict[CeedBasis_count]); 479 480 if (*err == 0) { 481 *basis = CeedBasis_count++; 482 CeedBasis_n++; 483 } 484 } 485 486 #define fCeedBasisCreateTensorH1 \ 487 FORTRAN_NAME(ceedbasiscreatetensorh1, CEEDBASISCREATETENSORH1) 488 void fCeedBasisCreateTensorH1(int *ceed, int *dim, int *ncomp, int *P1d, 489 int *Q1d, const CeedScalar *interp1d, 490 const CeedScalar *grad1d, 491 const CeedScalar *qref1d, 492 const CeedScalar *qweight1d, int *basis, 493 int *err) { 494 if (CeedBasis_count == CeedBasis_count_max) { 495 CeedBasis_count_max += CeedBasis_count_max/2 + 1; 496 CeedRealloc(CeedBasis_count_max, &CeedBasis_dict); 497 } 498 499 *err = CeedBasisCreateTensorH1(Ceed_dict[*ceed], *dim, *ncomp, *P1d, *Q1d, 500 interp1d, grad1d, qref1d, qweight1d, 501 &CeedBasis_dict[CeedBasis_count]); 502 503 if (*err == 0) { 504 *basis = CeedBasis_count++; 505 CeedBasis_n++; 506 } 507 } 508 509 #define fCeedBasisCreateH1 \ 510 FORTRAN_NAME(ceedbasiscreateh1, CEEDBASISCREATEH1) 511 void fCeedBasisCreateH1(int *ceed, int *topo, int *ncomp, int *nnodes, 512 int *nqpts, const CeedScalar *interp, 513 const CeedScalar *grad, const CeedScalar *qref, 514 const CeedScalar *qweight, int *basis, int *err) { 515 if (CeedBasis_count == CeedBasis_count_max) { 516 CeedBasis_count_max += CeedBasis_count_max/2 + 1; 517 CeedRealloc(CeedBasis_count_max, &CeedBasis_dict); 518 } 519 520 *err = CeedBasisCreateH1(Ceed_dict[*ceed], (CeedElemTopology)*topo, *ncomp, 521 *nnodes, *nqpts, interp, grad, qref, qweight, 522 &CeedBasis_dict[CeedBasis_count]); 523 524 if (*err == 0) { 525 *basis = CeedBasis_count++; 526 CeedBasis_n++; 527 } 528 } 529 530 #define fCeedBasisView FORTRAN_NAME(ceedbasisview, CEEDBASISVIEW) 531 void fCeedBasisView(int *basis, int *err) { 532 *err = CeedBasisView(CeedBasis_dict[*basis], stdout); 533 } 534 535 #define fCeedQRFactorization \ 536 FORTRAN_NAME(ceedqrfactorization, CEEDQRFACTORIZATION) 537 void fCeedQRFactorization(int *ceed, CeedScalar *mat, CeedScalar *tau, int *m, 538 int *n, int *err) { 539 *err = CeedQRFactorization(Ceed_dict[*ceed], mat, tau, *m, *n); 540 } 541 542 #define fCeedSymmetricSchurDecomposition \ 543 FORTRAN_NAME(ceedsymmetricschurdecomposition, CEEDSYMMETRICSCHURDECOMPOSITION) 544 void fCeedSymmetricSchurDecomposition(int *ceed, CeedScalar *mat, 545 CeedScalar *lambda, int *n, int *err) { 546 *err = CeedSymmetricSchurDecomposition(Ceed_dict[*ceed], mat, lambda, *n); 547 } 548 549 #define fCeedSimultaneousDiagonalization \ 550 FORTRAN_NAME(ceedsimultaneousdiagonalization, CEEDSIMULTANEOUSDIAGONALIZATION) 551 void fCeedSimultaneousDiagonalization(int *ceed, CeedScalar *matA, 552 CeedScalar *matB, CeedScalar *x, 553 CeedScalar *lambda, int *n, int *err) { 554 *err = CeedSimultaneousDiagonalization(Ceed_dict[*ceed], matA, matB, x, 555 lambda, *n); 556 } 557 558 #define fCeedBasisGetCollocatedGrad \ 559 FORTRAN_NAME(ceedbasisgetcollocatedgrad, CEEDBASISGETCOLLOCATEDGRAD) 560 void fCeedBasisGetCollocatedGrad(int *basis, CeedScalar *colograd1d, 561 int *err) { 562 *err = CeedBasisGetCollocatedGrad(CeedBasis_dict[*basis], colograd1d); 563 } 564 565 #define fCeedBasisApply FORTRAN_NAME(ceedbasisapply, CEEDBASISAPPLY) 566 void fCeedBasisApply(int *basis, int *nelem, int *tmode, int *emode, 567 int *u, int *v, int *err) { 568 *err = CeedBasisApply(CeedBasis_dict[*basis], *nelem, (CeedTransposeMode)*tmode, 569 (CeedEvalMode)*emode, 570 *u == FORTRAN_VECTOR_NONE ? CEED_VECTOR_NONE : CeedVector_dict[*u], 571 CeedVector_dict[*v]); 572 } 573 574 #define fCeedBasisGetNumNodes \ 575 FORTRAN_NAME(ceedbasisgetnumnodes, CEEDBASISGETNUMNODES) 576 void fCeedBasisGetNumNodes(int *basis, int *P, int *err) { 577 *err = CeedBasisGetNumNodes(CeedBasis_dict[*basis], P); 578 } 579 580 #define fCeedBasisGetNumQuadraturePoints \ 581 FORTRAN_NAME(ceedbasisgetnumquadraturepoints, CEEDBASISGETNUMQUADRATUREPOINTS) 582 void fCeedBasisGetNumQuadraturePoints(int *basis, int *Q, int *err) { 583 *err = CeedBasisGetNumQuadraturePoints(CeedBasis_dict[*basis], Q); 584 } 585 586 #define fCeedBasisDestroy FORTRAN_NAME(ceedbasisdestroy,CEEDBASISDESTROY) 587 void fCeedBasisDestroy(int *basis, int *err) { 588 if (CeedBasis_n == 0 || ! CeedBasis_dict[*basis]) return; 589 *err = CeedBasisDestroy(&CeedBasis_dict[*basis]); 590 591 if (*err == 0) { 592 CeedBasis_n--; 593 if (CeedBasis_n == 0) { 594 CeedFree(&CeedBasis_dict); 595 CeedBasis_count = 0; 596 CeedBasis_count_max = 0; 597 } 598 } 599 } 600 601 #define fCeedGaussQuadrature FORTRAN_NAME(ceedgaussquadrature, CEEDGAUSSQUADRATURE) 602 void fCeedGaussQuadrature(int *Q, CeedScalar *qref1d, CeedScalar *qweight1d, 603 int *err) { 604 *err = CeedGaussQuadrature(*Q, qref1d, qweight1d); 605 } 606 607 #define fCeedLobattoQuadrature \ 608 FORTRAN_NAME(ceedlobattoquadrature, CEEDLOBATTOQUADRATURE) 609 void fCeedLobattoQuadrature(int *Q, CeedScalar *qref1d, CeedScalar *qweight1d, 610 int *err) { 611 *err = CeedLobattoQuadrature(*Q, qref1d, qweight1d); 612 } 613 614 // ----------------------------------------------------------------------------- 615 // CeedQFunction 616 // ----------------------------------------------------------------------------- 617 static CeedQFunction *CeedQFunction_dict = NULL; 618 static int CeedQFunction_count = 0; 619 static int CeedQFunction_n = 0; 620 static int CeedQFunction_count_max = 0; 621 622 static int CeedQFunctionFortranStub(void *ctx, int nq, 623 const CeedScalar *const *u, 624 CeedScalar *const *v) { 625 fContext *fctx = ctx; 626 int ierr; 627 628 CeedScalar *ctx_ = (CeedScalar *) fctx->innerctx; 629 fctx->f((void *)ctx_,&nq,u[0],u[1],u[2],u[3],u[4],u[5],u[6], 630 u[7],u[8],u[9],u[10],u[11],u[12],u[13],u[14],u[15], 631 v[0],v[1],v[2],v[3],v[4],v[5],v[6],v[7],v[8],v[9], 632 v[10],v[11],v[12],v[13],v[14],v[15],&ierr); 633 return ierr; 634 } 635 636 #define fCeedQFunctionCreateInterior \ 637 FORTRAN_NAME(ceedqfunctioncreateinterior, CEEDQFUNCTIONCREATEINTERIOR) 638 void fCeedQFunctionCreateInterior(int *ceed, int *vlength, 639 void (*f)(void *ctx, int *nq, 640 const CeedScalar *u,const CeedScalar *u1, 641 const CeedScalar *u2,const CeedScalar *u3, 642 const CeedScalar *u4,const CeedScalar *u5, 643 const CeedScalar *u6,const CeedScalar *u7, 644 const CeedScalar *u8,const CeedScalar *u9, 645 const CeedScalar *u10,const CeedScalar *u11, 646 const CeedScalar *u12,const CeedScalar *u13, 647 const CeedScalar *u14,const CeedScalar *u15, 648 CeedScalar *v,CeedScalar *v1,CeedScalar *v2, 649 CeedScalar *v3,CeedScalar *v4, 650 CeedScalar *v5,CeedScalar *v6, 651 CeedScalar *v7,CeedScalar *v8, 652 CeedScalar *v9,CeedScalar *v10, 653 CeedScalar *v11,CeedScalar *v12, 654 CeedScalar *v13,CeedScalar *v14, 655 CeedScalar *v15,int *err), 656 const char *source, int *qf, int *err, 657 fortran_charlen_t source_len) { 658 FIX_STRING(source); 659 if (CeedQFunction_count == CeedQFunction_count_max) { 660 CeedQFunction_count_max += CeedQFunction_count_max/2 + 1; 661 CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict); 662 } 663 664 CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count]; 665 *err = CeedQFunctionCreateInterior(Ceed_dict[*ceed], *vlength, 666 CeedQFunctionFortranStub, source_c, qf_); 667 668 if (*err == 0) { 669 *qf = CeedQFunction_count++; 670 CeedQFunction_n++; 671 } 672 673 fContext *fctx; 674 *err = CeedMalloc(1, &fctx); 675 if (*err) return; 676 fctx->f = f; fctx->innerctx = NULL; fctx->innerctxsize = 0; 677 678 *err = CeedQFunctionSetContext(*qf_, fctx, sizeof(fContext)); 679 680 (*qf_)->fortranstatus = true; 681 } 682 683 #define fCeedQFunctionCreateInteriorByName \ 684 FORTRAN_NAME(ceedqfunctioncreateinteriorbyname, CEEDQFUNCTIONCREATEINTERIORBYNAME) 685 void fCeedQFunctionCreateInteriorByName(int *ceed, const char *name, int *qf, 686 int *err, fortran_charlen_t name_len) { 687 FIX_STRING(name); 688 if (CeedQFunction_count == CeedQFunction_count_max) { 689 CeedQFunction_count_max += CeedQFunction_count_max/2 + 1; 690 CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict); 691 } 692 693 CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count]; 694 *err = CeedQFunctionCreateInteriorByName(Ceed_dict[*ceed], name_c, qf_); 695 696 if (*err == 0) { 697 *qf = CeedQFunction_count++; 698 CeedQFunction_n++; 699 } 700 } 701 702 #define fCeedQFunctionCreateIdentity \ 703 FORTRAN_NAME(ceedqfunctioncreateidentity, CEEDQFUNCTIONCREATEIDENTITY) 704 void fCeedQFunctionCreateIdentity(int *ceed, int *size, int *inmode, 705 int *outmode, int *qf, int *err) { 706 if (CeedQFunction_count == CeedQFunction_count_max) { 707 CeedQFunction_count_max += CeedQFunction_count_max/2 + 1; 708 CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict); 709 } 710 711 CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count]; 712 *err = CeedQFunctionCreateIdentity(Ceed_dict[*ceed], *size, 713 (CeedEvalMode)*inmode, 714 (CeedEvalMode)*outmode, qf_); 715 716 if (*err == 0) { 717 *qf = CeedQFunction_count++; 718 CeedQFunction_n++; 719 } 720 } 721 722 #define fCeedQFunctionAddInput \ 723 FORTRAN_NAME(ceedqfunctionaddinput,CEEDQFUNCTIONADDINPUT) 724 void fCeedQFunctionAddInput(int *qf, const char *fieldname, 725 CeedInt *ncomp, CeedEvalMode *emode, int *err, 726 fortran_charlen_t fieldname_len) { 727 FIX_STRING(fieldname); 728 CeedQFunction qf_ = CeedQFunction_dict[*qf]; 729 730 *err = CeedQFunctionAddInput(qf_, fieldname_c, *ncomp, *emode); 731 } 732 733 #define fCeedQFunctionAddOutput \ 734 FORTRAN_NAME(ceedqfunctionaddoutput,CEEDQFUNCTIONADDOUTPUT) 735 void fCeedQFunctionAddOutput(int *qf, const char *fieldname, 736 CeedInt *ncomp, CeedEvalMode *emode, int *err, 737 fortran_charlen_t fieldname_len) { 738 FIX_STRING(fieldname); 739 CeedQFunction qf_ = CeedQFunction_dict[*qf]; 740 741 *err = CeedQFunctionAddOutput(qf_, fieldname_c, *ncomp, *emode); 742 } 743 744 #define fCeedQFunctionSetContext \ 745 FORTRAN_NAME(ceedqfunctionsetcontext,CEEDQFUNCTIONSETCONTEXT) 746 void fCeedQFunctionSetContext(int *qf, CeedScalar *ctx, CeedInt *n, int *err) { 747 CeedQFunction qf_ = CeedQFunction_dict[*qf]; 748 749 fContext *fctx = qf_->ctx; 750 fctx->innerctx = ctx; 751 fctx->innerctxsize = ((size_t) *n)*sizeof(CeedScalar); 752 } 753 754 #define fCeedQFunctionView \ 755 FORTRAN_NAME(ceedqfunctionview,CEEDQFUNCTIONVIEW) 756 void fCeedQFunctionView(int *qf, int *err) { 757 CeedQFunction qf_ = CeedQFunction_dict[*qf]; 758 759 *err = CeedQFunctionView(qf_, stdout); 760 } 761 762 #define fCeedQFunctionApply \ 763 FORTRAN_NAME(ceedqfunctionapply,CEEDQFUNCTIONAPPLY) 764 //TODO Need Fixing, double pointer 765 void fCeedQFunctionApply(int *qf, int *Q, 766 int *u, int *u1, int *u2, int *u3, 767 int *u4, int *u5, int *u6, int *u7, 768 int *u8, int *u9, int *u10, int *u11, 769 int *u12, int *u13, int *u14, int *u15, 770 int *v, int *v1, int *v2, int *v3, 771 int *v4, int *v5, int *v6, int *v7, 772 int *v8, int *v9, int *v10, int *v11, 773 int *v12, int *v13, int *v14, int *v15, int *err) { 774 CeedQFunction qf_ = CeedQFunction_dict[*qf]; 775 CeedVector *in; 776 *err = CeedCalloc(16, &in); 777 if (*err) return; 778 in[0] = *u==FORTRAN_NULL?NULL:CeedVector_dict[*u]; 779 in[1] = *u1==FORTRAN_NULL?NULL:CeedVector_dict[*u1]; 780 in[2] = *u2==FORTRAN_NULL?NULL:CeedVector_dict[*u2]; 781 in[3] = *u3==FORTRAN_NULL?NULL:CeedVector_dict[*u3]; 782 in[4] = *u4==FORTRAN_NULL?NULL:CeedVector_dict[*u4]; 783 in[5] = *u5==FORTRAN_NULL?NULL:CeedVector_dict[*u5]; 784 in[6] = *u6==FORTRAN_NULL?NULL:CeedVector_dict[*u6]; 785 in[7] = *u7==FORTRAN_NULL?NULL:CeedVector_dict[*u7]; 786 in[8] = *u8==FORTRAN_NULL?NULL:CeedVector_dict[*u8]; 787 in[9] = *u9==FORTRAN_NULL?NULL:CeedVector_dict[*u9]; 788 in[10] = *u10==FORTRAN_NULL?NULL:CeedVector_dict[*u10]; 789 in[11] = *u11==FORTRAN_NULL?NULL:CeedVector_dict[*u11]; 790 in[12] = *u12==FORTRAN_NULL?NULL:CeedVector_dict[*u12]; 791 in[13] = *u13==FORTRAN_NULL?NULL:CeedVector_dict[*u13]; 792 in[14] = *u14==FORTRAN_NULL?NULL:CeedVector_dict[*u14]; 793 in[15] = *u15==FORTRAN_NULL?NULL:CeedVector_dict[*u15]; 794 CeedVector *out; 795 *err = CeedCalloc(16, &out); 796 if (*err) return; 797 out[0] = *v==FORTRAN_NULL?NULL:CeedVector_dict[*v]; 798 out[1] = *v1==FORTRAN_NULL?NULL:CeedVector_dict[*v1]; 799 out[2] = *v2==FORTRAN_NULL?NULL:CeedVector_dict[*v2]; 800 out[3] = *v3==FORTRAN_NULL?NULL:CeedVector_dict[*v3]; 801 out[4] = *v4==FORTRAN_NULL?NULL:CeedVector_dict[*v4]; 802 out[5] = *v5==FORTRAN_NULL?NULL:CeedVector_dict[*v5]; 803 out[6] = *v6==FORTRAN_NULL?NULL:CeedVector_dict[*v6]; 804 out[7] = *v7==FORTRAN_NULL?NULL:CeedVector_dict[*v7]; 805 out[8] = *v8==FORTRAN_NULL?NULL:CeedVector_dict[*v8]; 806 out[9] = *v9==FORTRAN_NULL?NULL:CeedVector_dict[*v9]; 807 out[10] = *v10==FORTRAN_NULL?NULL:CeedVector_dict[*v10]; 808 out[11] = *v11==FORTRAN_NULL?NULL:CeedVector_dict[*v11]; 809 out[12] = *v12==FORTRAN_NULL?NULL:CeedVector_dict[*v12]; 810 out[13] = *v13==FORTRAN_NULL?NULL:CeedVector_dict[*v13]; 811 out[14] = *v14==FORTRAN_NULL?NULL:CeedVector_dict[*v14]; 812 out[15] = *v15==FORTRAN_NULL?NULL:CeedVector_dict[*v15]; 813 *err = CeedQFunctionApply(qf_, *Q, in, out); 814 if (*err) return; 815 816 *err = CeedFree(&in); 817 if (*err) return; 818 *err = CeedFree(&out); 819 } 820 821 #define fCeedQFunctionDestroy \ 822 FORTRAN_NAME(ceedqfunctiondestroy,CEEDQFUNCTIONDESTROY) 823 void fCeedQFunctionDestroy(int *qf, int *err) { 824 if (CeedQFunction_n == 0 || !CeedQFunction_dict[*qf]) return; 825 bool fstatus; 826 *err = CeedQFunctionIsFortran(CeedQFunction_dict[*qf], &fstatus); 827 if (*err) return; 828 if (fstatus) { 829 fContext *fctx = CeedQFunction_dict[*qf]->ctx; 830 *err = CeedFree(&fctx); 831 if (*err) return; 832 } 833 834 *err = CeedQFunctionDestroy(&CeedQFunction_dict[*qf]); 835 if (*err) return; 836 837 CeedQFunction_n--; 838 if (CeedQFunction_n == 0) { 839 *err = CeedFree(&CeedQFunction_dict); 840 CeedQFunction_count = 0; 841 CeedQFunction_count_max = 0; 842 } 843 } 844 845 // ----------------------------------------------------------------------------- 846 // CeedOperator 847 // ----------------------------------------------------------------------------- 848 static CeedOperator *CeedOperator_dict = NULL; 849 static int CeedOperator_count = 0; 850 static int CeedOperator_n = 0; 851 static int CeedOperator_count_max = 0; 852 853 #define fCeedOperatorCreate \ 854 FORTRAN_NAME(ceedoperatorcreate, CEEDOPERATORCREATE) 855 void fCeedOperatorCreate(int *ceed, 856 int *qf, int *dqf, int *dqfT, int *op, int *err) { 857 if (CeedOperator_count == CeedOperator_count_max) 858 CeedOperator_count_max += CeedOperator_count_max/2 + 1, 859 CeedOperator_dict = realloc(CeedOperator_dict, 860 sizeof(CeedOperator)*CeedOperator_count_max); 861 862 CeedOperator *op_ = &CeedOperator_dict[CeedOperator_count]; 863 864 CeedQFunction dqf_ = CEED_QFUNCTION_NONE, dqfT_ = CEED_QFUNCTION_NONE; 865 if (*dqf != FORTRAN_QFUNCTION_NONE) dqf_ = CeedQFunction_dict[*dqf ]; 866 if (*dqfT != FORTRAN_QFUNCTION_NONE) dqfT_ = CeedQFunction_dict[*dqfT]; 867 868 *err = CeedOperatorCreate(Ceed_dict[*ceed], CeedQFunction_dict[*qf], dqf_, 869 dqfT_, op_); 870 if (*err) return; 871 *op = CeedOperator_count++; 872 CeedOperator_n++; 873 } 874 875 #define fCeedCompositeOperatorCreate \ 876 FORTRAN_NAME(ceedcompositeoperatorcreate, CEEDCOMPOSITEOPERATORCREATE) 877 void fCeedCompositeOperatorCreate(int *ceed, int *op, int *err) { 878 if (CeedOperator_count == CeedOperator_count_max) 879 CeedOperator_count_max += CeedOperator_count_max/2 + 1, 880 CeedOperator_dict = realloc(CeedOperator_dict, 881 sizeof(CeedOperator)*CeedOperator_count_max); 882 883 CeedOperator *op_ = &CeedOperator_dict[CeedOperator_count]; 884 885 *err = CeedCompositeOperatorCreate(Ceed_dict[*ceed], op_); 886 if (*err) return; 887 *op = CeedOperator_count++; 888 CeedOperator_n++; 889 } 890 891 #define fCeedOperatorSetField \ 892 FORTRAN_NAME(ceedoperatorsetfield,CEEDOPERATORSETFIELD) 893 void fCeedOperatorSetField(int *op, const char *fieldname, int *r, int *b, 894 int *v, int *err, fortran_charlen_t fieldname_len) { 895 FIX_STRING(fieldname); 896 CeedElemRestriction r_; 897 CeedBasis b_; 898 CeedVector v_; 899 900 CeedOperator op_ = CeedOperator_dict[*op]; 901 902 if (*r == FORTRAN_NULL) { 903 r_ = NULL; 904 } else if (*r == FORTRAN_ELEMRESTRICTION_NONE) { 905 r_ = CEED_ELEMRESTRICTION_NONE; 906 } else { 907 r_ = CeedElemRestriction_dict[*r]; 908 } 909 910 if (*b == FORTRAN_NULL) { 911 b_ = NULL; 912 } else if (*b == FORTRAN_BASIS_COLLOCATED) { 913 b_ = CEED_BASIS_COLLOCATED; 914 } else { 915 b_ = CeedBasis_dict[*b]; 916 } 917 if (*v == FORTRAN_NULL) { 918 v_ = NULL; 919 } else if (*v == FORTRAN_VECTOR_ACTIVE) { 920 v_ = CEED_VECTOR_ACTIVE; 921 } else if (*v == FORTRAN_VECTOR_NONE) { 922 v_ = CEED_VECTOR_NONE; 923 } else { 924 v_ = CeedVector_dict[*v]; 925 } 926 927 *err = CeedOperatorSetField(op_, fieldname_c, r_, b_, v_); 928 } 929 930 #define fCeedCompositeOperatorAddSub \ 931 FORTRAN_NAME(ceedcompositeoperatoraddsub, CEEDCOMPOSITEOPERATORADDSUB) 932 void fCeedCompositeOperatorAddSub(int *compositeop, int *subop, int *err) { 933 CeedOperator compositeop_ = CeedOperator_dict[*compositeop]; 934 CeedOperator subop_ = CeedOperator_dict[*subop]; 935 936 *err = CeedCompositeOperatorAddSub(compositeop_, subop_); 937 if (*err) return; 938 } 939 940 #define fCeedOperatorLinearAssembleQFunction FORTRAN_NAME(ceedoperatorlinearassembleqfunction, CEEDOPERATORLINEARASSEMBLEQFUNCTION) 941 void fCeedOperatorLinearAssembleQFunction(int *op, int *assembledvec, 942 int *assembledrstr, int *rqst, int *err) { 943 // Vector 944 if (CeedVector_count == CeedVector_count_max) { 945 CeedVector_count_max += CeedVector_count_max/2 + 1; 946 CeedRealloc(CeedVector_count_max, &CeedVector_dict); 947 } 948 CeedVector *assembledvec_ = &CeedVector_dict[CeedVector_count]; 949 950 // Restriction 951 if (CeedElemRestriction_count == CeedElemRestriction_count_max) { 952 CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1; 953 CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict); 954 } 955 CeedElemRestriction *rstr_ = 956 &CeedElemRestriction_dict[CeedElemRestriction_count]; 957 958 int createRequest = 1; 959 // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1) 960 if (*rqst == -1 || *rqst == -2) { 961 createRequest = 0; 962 } 963 964 if (createRequest && CeedRequest_count == CeedRequest_count_max) { 965 CeedRequest_count_max += CeedRequest_count_max/2 + 1; 966 CeedRealloc(CeedRequest_count_max, &CeedRequest_dict); 967 } 968 969 CeedRequest *rqst_; 970 if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE; 971 else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED; 972 else rqst_ = &CeedRequest_dict[CeedRequest_count]; 973 974 *err = CeedOperatorLinearAssembleQFunction(CeedOperator_dict[*op], 975 assembledvec_, rstr_, rqst_); 976 if (*err) return; 977 if (createRequest) { 978 *rqst = CeedRequest_count++; 979 CeedRequest_n++; 980 } 981 982 if (*err == 0) { 983 *assembledrstr = CeedElemRestriction_count++; 984 CeedElemRestriction_n++; 985 *assembledvec = CeedVector_count++; 986 CeedVector_n++; 987 } 988 } 989 990 #define fCeedOperatorLinearAssembleDiagonal FORTRAN_NAME(ceedoperatorlinearassemblediagonal, CEEDOPERATORLINEARASSEMBLEDIAGONAL) 991 void fCeedOperatorLinearAssembleDiagonal(int *op, int *assembledvec, 992 int *rqst, int *err) { 993 int createRequest = 1; 994 // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1) 995 if (*rqst == -1 || *rqst == -2) { 996 createRequest = 0; 997 } 998 999 if (createRequest && CeedRequest_count == CeedRequest_count_max) { 1000 CeedRequest_count_max += CeedRequest_count_max/2 + 1; 1001 CeedRealloc(CeedRequest_count_max, &CeedRequest_dict); 1002 } 1003 1004 CeedRequest *rqst_; 1005 if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE; 1006 else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED; 1007 else rqst_ = &CeedRequest_dict[CeedRequest_count]; 1008 1009 *err = CeedOperatorLinearAssembleDiagonal(CeedOperator_dict[*op], 1010 CeedVector_dict[*assembledvec], rqst_); 1011 if (*err) return; 1012 if (createRequest) { 1013 *rqst = CeedRequest_count++; 1014 CeedRequest_n++; 1015 } 1016 } 1017 1018 #define fCeedOperatorView \ 1019 FORTRAN_NAME(ceedoperatorview,CEEDOPERATORVIEW) 1020 void fCeedOperatorView(int *op, int *err) { 1021 CeedOperator op_ = CeedOperator_dict[*op]; 1022 1023 *err = CeedOperatorView(op_, stdout); 1024 } 1025 1026 #define fCeedOperatorCreateFDMElementInverse FORTRAN_NAME(ceedoperatorcreatefdmelementinverse, CEEDOPERATORCREATEFDMELEMENTINVERSE) 1027 void fCeedOperatorCreateFDMElementInverse(int *op, int *fdminv, 1028 int *rqst, int *err) { 1029 // Operator 1030 if (CeedOperator_count == CeedOperator_count_max) { 1031 CeedOperator_count_max += CeedOperator_count_max/2 + 1; 1032 CeedRealloc(CeedOperator_count_max, &CeedOperator_dict); 1033 } 1034 CeedOperator *fdminv_ = 1035 &CeedOperator_dict[CeedOperator_count]; 1036 1037 int createRequest = 1; 1038 // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1) 1039 if (*rqst == -1 || *rqst == -2) { 1040 createRequest = 0; 1041 } 1042 1043 if (createRequest && CeedRequest_count == CeedRequest_count_max) { 1044 CeedRequest_count_max += CeedRequest_count_max/2 + 1; 1045 CeedRealloc(CeedRequest_count_max, &CeedRequest_dict); 1046 } 1047 1048 CeedRequest *rqst_; 1049 if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE; 1050 else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED; 1051 else rqst_ = &CeedRequest_dict[CeedRequest_count]; 1052 1053 *err = CeedOperatorCreateFDMElementInverse(CeedOperator_dict[*op], 1054 fdminv_, rqst_); 1055 if (*err) return; 1056 if (createRequest) { 1057 *rqst = CeedRequest_count++; 1058 CeedRequest_n++; 1059 } 1060 1061 if (*err == 0) { 1062 *fdminv = CeedOperator_count++; 1063 CeedOperator_n++; 1064 } 1065 } 1066 1067 #define fCeedOperatorApply FORTRAN_NAME(ceedoperatorapply, CEEDOPERATORAPPLY) 1068 void fCeedOperatorApply(int *op, int *ustatevec, 1069 int *resvec, int *rqst, int *err) { 1070 CeedVector ustatevec_ = (*ustatevec == FORTRAN_NULL) ? 1071 NULL : (*ustatevec == FORTRAN_VECTOR_NONE ? 1072 CEED_VECTOR_NONE : CeedVector_dict[*ustatevec]); 1073 CeedVector resvec_ = (*resvec == FORTRAN_NULL) ? 1074 NULL : (*resvec == FORTRAN_VECTOR_NONE ? 1075 CEED_VECTOR_NONE : CeedVector_dict[*resvec]); 1076 1077 int createRequest = 1; 1078 // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1) 1079 if (*rqst == -1 || *rqst == -2) { 1080 createRequest = 0; 1081 } 1082 1083 if (createRequest && CeedRequest_count == CeedRequest_count_max) { 1084 CeedRequest_count_max += CeedRequest_count_max/2 + 1; 1085 CeedRealloc(CeedRequest_count_max, &CeedRequest_dict); 1086 } 1087 1088 CeedRequest *rqst_; 1089 if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE; 1090 else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED; 1091 else rqst_ = &CeedRequest_dict[CeedRequest_count]; 1092 1093 *err = CeedOperatorApply(CeedOperator_dict[*op], 1094 ustatevec_, resvec_, rqst_); 1095 if (*err) return; 1096 if (createRequest) { 1097 *rqst = CeedRequest_count++; 1098 CeedRequest_n++; 1099 } 1100 } 1101 1102 #define fCeedOperatorApplyAdd FORTRAN_NAME(ceedoperatorapplyadd, CEEDOPERATORAPPLYADD) 1103 void fCeedOperatorApplyAdd(int *op, int *ustatevec, 1104 int *resvec, int *rqst, int *err) { 1105 CeedVector ustatevec_ = *ustatevec == FORTRAN_NULL 1106 ? NULL : CeedVector_dict[*ustatevec]; 1107 CeedVector resvec_ = *resvec == FORTRAN_NULL 1108 ? NULL : CeedVector_dict[*resvec]; 1109 1110 int createRequest = 1; 1111 // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1) 1112 if (*rqst == -1 || *rqst == -2) { 1113 createRequest = 0; 1114 } 1115 1116 if (createRequest && CeedRequest_count == CeedRequest_count_max) { 1117 CeedRequest_count_max += CeedRequest_count_max/2 + 1; 1118 CeedRealloc(CeedRequest_count_max, &CeedRequest_dict); 1119 } 1120 1121 CeedRequest *rqst_; 1122 if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE; 1123 else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED; 1124 else rqst_ = &CeedRequest_dict[CeedRequest_count]; 1125 1126 *err = CeedOperatorApplyAdd(CeedOperator_dict[*op], 1127 ustatevec_, resvec_, rqst_); 1128 if (*err) return; 1129 if (createRequest) { 1130 *rqst = CeedRequest_count++; 1131 CeedRequest_n++; 1132 } 1133 } 1134 1135 #define fCeedOperatorApplyJacobian \ 1136 FORTRAN_NAME(ceedoperatorapplyjacobian, CEEDOPERATORAPPLYJACOBIAN) 1137 void fCeedOperatorApplyJacobian(int *op, int *qdatavec, int *ustatevec, 1138 int *dustatevec, int *dresvec, int *rqst, 1139 int *err) { 1140 // TODO Uncomment this when CeedOperatorApplyJacobian is implemented 1141 // *err = CeedOperatorApplyJacobian(CeedOperator_dict[*op], CeedVector_dict[*qdatavec], 1142 // CeedVector_dict[*ustatevec], CeedVector_dict[*dustatevec], 1143 // CeedVector_dict[*dresvec], &CeedRequest_dict[*rqst]); 1144 } 1145 1146 #define fCeedOperatorDestroy \ 1147 FORTRAN_NAME(ceedoperatordestroy, CEEDOPERATORDESTROY) 1148 void fCeedOperatorDestroy(int *op, int *err) { 1149 if (CeedOperator_n == 0 || !CeedOperator_dict[*op]) return; 1150 *err = CeedOperatorDestroy(&CeedOperator_dict[*op]); 1151 if (*err) return; 1152 CeedOperator_n--; 1153 if (CeedOperator_n == 0) { 1154 *err = CeedFree(&CeedOperator_dict); 1155 CeedOperator_count = 0; 1156 CeedOperator_count_max = 0; 1157 } 1158 } 1159 1160 // ----------------------------------------------------------------------------- 1161