xref: /libCEED/rust/libceed-sys/c-src/interface/ceed-fortran.c (revision 9c774eddf8c0b4f5416196d32c5355c9591a7190)
1c8817ca9Svaleriabarra // Copyright (c) 2017-2018, Lawrence Livermore National Security, LLC.
2c8817ca9Svaleriabarra // Produced at the Lawrence Livermore National Laboratory. LLNL-CODE-734707.
3c8817ca9Svaleriabarra // All Rights reserved. See files LICENSE and NOTICE for details.
4c8817ca9Svaleriabarra //
5c8817ca9Svaleriabarra // This file is part of CEED, a collection of benchmarks, miniapps, software
6c8817ca9Svaleriabarra // libraries and APIs for efficient high-order finite element and spectral
7c8817ca9Svaleriabarra // element discretizations for exascale applications. For more information and
8c8817ca9Svaleriabarra // source code availability see http://github.com/ceed.
9c8817ca9Svaleriabarra //
10c8817ca9Svaleriabarra // The CEED research is supported by the Exascale Computing Project 17-SC-20-SC,
11c8817ca9Svaleriabarra // a collaborative effort of two U.S. Department of Energy organizations (Office
12c8817ca9Svaleriabarra // of Science and the National Nuclear Security Administration) responsible for
13c8817ca9Svaleriabarra // the planning and preparation of a capable exascale ecosystem, including
14c8817ca9Svaleriabarra // software, applications, hardware, advanced system engineering and early
15c8817ca9Svaleriabarra // testbed platforms, in support of the nation's exascale computing imperative.
16c8817ca9Svaleriabarra 
17d7b241e6Sjeremylt // Fortran interface
18ec3da8bcSJed Brown #include <ceed/ceed.h>
19ec3da8bcSJed Brown #include <ceed/backend.h>
203d576824SJeremy L Thompson #include <ceed-impl.h>
21d7b241e6Sjeremylt #include <ceed-fortran-name.h>
223d576824SJeremy L Thompson #include <stdbool.h>
233d576824SJeremy L Thompson #include <stdint.h>
243d576824SJeremy L Thompson #include <stdio.h>
25d7b241e6Sjeremylt #include <string.h>
26d7b241e6Sjeremylt 
27d7b241e6Sjeremylt #define FORTRAN_REQUEST_IMMEDIATE -1
28d7b241e6Sjeremylt #define FORTRAN_REQUEST_ORDERED -2
29d7b241e6Sjeremylt #define FORTRAN_NULL -3
3015910d16Sjeremylt #define FORTRAN_STRIDES_BACKEND -4
3115910d16Sjeremylt #define FORTRAN_VECTOR_ACTIVE -5
3215910d16Sjeremylt #define FORTRAN_VECTOR_NONE -6
3315910d16Sjeremylt #define FORTRAN_ELEMRESTRICTION_NONE -7
3415910d16Sjeremylt #define FORTRAN_BASIS_COLLOCATED -8
3515910d16Sjeremylt #define FORTRAN_QFUNCTION_NONE -9
36d7b241e6Sjeremylt 
37d7b241e6Sjeremylt static Ceed *Ceed_dict = NULL;
38d7b241e6Sjeremylt static int Ceed_count = 0;
39d7b241e6Sjeremylt static int Ceed_n = 0;
40d7b241e6Sjeremylt static int Ceed_count_max = 0;
41d7b241e6Sjeremylt 
42c2ae719dSJed Brown // This test should actually be for the gfortran version, but we don't currently
43c2ae719dSJed Brown // have a configure system to determine that (TODO).  At present, this will use
44c2ae719dSJed Brown // the smaller integer when run with clang+gfortran=8, for example.  (That is
45c2ae719dSJed Brown // sketchy, but will likely work for users that don't have huge character
46c2ae719dSJed Brown // strings.)
47c2ae719dSJed Brown #if __GNUC__ >= 8
48c2ae719dSJed Brown typedef size_t fortran_charlen_t;
49c2ae719dSJed Brown #else
50c2ae719dSJed Brown typedef int fortran_charlen_t;
51c2ae719dSJed Brown #endif
52c2ae719dSJed Brown 
53c2ae719dSJed Brown #define Splice(a, b) a ## b
54c2ae719dSJed Brown 
55c2ae719dSJed Brown // Fortran strings are generally unterminated and the length is passed as an
56c2ae719dSJed Brown // extra argument after all the normal arguments.  Some compilers (I only know
57c2ae719dSJed Brown // of Windows) place the length argument immediately after the string parameter
58c2ae719dSJed Brown // (TODO).
59c2ae719dSJed Brown //
60c2ae719dSJed Brown // We can't just NULL-terminate the string in-place because that could overwrite
61c2ae719dSJed Brown // other strings or attempt to write to read-only memory.  This macro allocates
62c2ae719dSJed Brown // a string to hold the null-terminated version of the string that C expects.
63c2ae719dSJed Brown #define FIX_STRING(stringname)                                          \
64c2ae719dSJed Brown   char Splice(stringname, _c)[1024];                                    \
65c2ae719dSJed Brown   if (Splice(stringname, _len) > 1023)                                  \
6645f1e315Sjeremylt     *err = CeedError(NULL, 1, "Fortran string length too long %zd", (size_t)Splice(stringname, _len)); \
67c2ae719dSJed Brown   strncpy(Splice(stringname, _c), stringname, Splice(stringname, _len)); \
68c2ae719dSJed Brown   Splice(stringname, _c)[Splice(stringname, _len)] = 0;                 \
69c2ae719dSJed Brown 
70b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
71b00b43a6SJeremy L Thompson // Ceed
72b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
73d7b241e6Sjeremylt #define fCeedInit FORTRAN_NAME(ceedinit,CEEDINIT)
74c2ae719dSJed Brown void fCeedInit(const char *resource, int *ceed, int *err,
75c2ae719dSJed Brown                fortran_charlen_t resource_len) {
76c2ae719dSJed Brown   FIX_STRING(resource);
77d7b241e6Sjeremylt   if (Ceed_count == Ceed_count_max) {
78d7b241e6Sjeremylt     Ceed_count_max += Ceed_count_max/2 + 1;
79d7b241e6Sjeremylt     CeedRealloc(Ceed_count_max, &Ceed_dict);
80d7b241e6Sjeremylt   }
81d7b241e6Sjeremylt 
82d7b241e6Sjeremylt   Ceed *ceed_ = &Ceed_dict[Ceed_count];
83c2ae719dSJed Brown   *err = CeedInit(resource_c, ceed_);
84d7b241e6Sjeremylt 
85d7b241e6Sjeremylt   if (*err == 0) {
86d7b241e6Sjeremylt     *ceed = Ceed_count++;
87d7b241e6Sjeremylt     Ceed_n++;
88d7b241e6Sjeremylt   }
89d7b241e6Sjeremylt }
90d7b241e6Sjeremylt 
919525855cSJeremy L Thompson #define fCeedIsDeterministic \
929525855cSJeremy L Thompson     FORTRAN_NAME(ceedisdeterministic,CEEDISDETERMINISTIC)
93d1d35e2fSjeremylt void fCeedIsDeterministic(int *ceed, int *is_deterministic, int *err) {
94d1d35e2fSjeremylt   *err = CeedIsDeterministic(Ceed_dict[*ceed], (bool *)is_deterministic);
959525855cSJeremy L Thompson }
969525855cSJeremy L Thompson 
97c907536fSjeremylt #define fCeedGetPreferredMemType \
98c907536fSjeremylt     FORTRAN_NAME(ceedgetpreferredmemtype,CEEDGETPREFERREDMEMTYPE)
99c907536fSjeremylt void fCeedGetPreferredMemType(int *ceed, int *type, int *err) {
100c907536fSjeremylt   *err = CeedGetPreferredMemType(Ceed_dict[*ceed], (CeedMemType *)type);
101c907536fSjeremylt }
102c907536fSjeremylt 
1030a0da059Sjeremylt #define fCeedView FORTRAN_NAME(ceedview,CEEDVIEW)
1040a0da059Sjeremylt void fCeedView(int *ceed, int *err) {
1050a0da059Sjeremylt   *err = CeedView(Ceed_dict[*ceed], stdout);
1060a0da059Sjeremylt }
1070a0da059Sjeremylt 
108d7b241e6Sjeremylt #define fCeedDestroy FORTRAN_NAME(ceeddestroy,CEEDDESTROY)
109d7b241e6Sjeremylt void fCeedDestroy(int *ceed, int *err) {
110b22696a8SJeremy L Thompson   if (*ceed == FORTRAN_NULL) return;
111d7b241e6Sjeremylt   *err = CeedDestroy(&Ceed_dict[*ceed]);
112d7b241e6Sjeremylt 
113d7b241e6Sjeremylt   if (*err == 0) {
11416595307SJeremy L Thompson     *ceed = FORTRAN_NULL;
115d7b241e6Sjeremylt     Ceed_n--;
116d7b241e6Sjeremylt     if (Ceed_n == 0) {
117d7b241e6Sjeremylt       CeedFree(&Ceed_dict);
118d7b241e6Sjeremylt       Ceed_count = 0;
119d7b241e6Sjeremylt       Ceed_count_max = 0;
120d7b241e6Sjeremylt     }
121d7b241e6Sjeremylt   }
122d7b241e6Sjeremylt }
123d7b241e6Sjeremylt 
124b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
125b00b43a6SJeremy L Thompson // CeedVector
126b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
127d7b241e6Sjeremylt static CeedVector *CeedVector_dict = NULL;
128d7b241e6Sjeremylt static int CeedVector_count = 0;
129d7b241e6Sjeremylt static int CeedVector_n = 0;
130d7b241e6Sjeremylt static int CeedVector_count_max = 0;
131d7b241e6Sjeremylt 
132d7b241e6Sjeremylt #define fCeedVectorCreate FORTRAN_NAME(ceedvectorcreate,CEEDVECTORCREATE)
133d7b241e6Sjeremylt void fCeedVectorCreate(int *ceed, int *length, int *vec, int *err) {
134d7b241e6Sjeremylt   if (CeedVector_count == CeedVector_count_max) {
135d7b241e6Sjeremylt     CeedVector_count_max += CeedVector_count_max/2 + 1;
136d7b241e6Sjeremylt     CeedRealloc(CeedVector_count_max, &CeedVector_dict);
137d7b241e6Sjeremylt   }
138d7b241e6Sjeremylt 
139d7b241e6Sjeremylt   CeedVector *vec_ = &CeedVector_dict[CeedVector_count];
140d7b241e6Sjeremylt   *err = CeedVectorCreate(Ceed_dict[*ceed], *length, vec_);
141d7b241e6Sjeremylt 
142d7b241e6Sjeremylt   if (*err == 0) {
143d7b241e6Sjeremylt     *vec = CeedVector_count++;
144d7b241e6Sjeremylt     CeedVector_n++;
145d7b241e6Sjeremylt   }
146d7b241e6Sjeremylt }
147d7b241e6Sjeremylt 
148d7b241e6Sjeremylt #define fCeedVectorSetArray FORTRAN_NAME(ceedvectorsetarray,CEEDVECTORSETARRAY)
149d7b241e6Sjeremylt void fCeedVectorSetArray(int *vec, int *memtype, int *copymode,
150c8b9fe72Sjeremylt                          CeedScalar *array, int64_t *offset, int *err) {
151399bb197SJed Brown   *err = CeedVectorSetArray(CeedVector_dict[*vec], (CeedMemType)*memtype,
152399bb197SJed Brown                             (CeedCopyMode)*copymode,
153c8b9fe72Sjeremylt                             (CeedScalar *)(array + *offset));
154d7b241e6Sjeremylt }
155d7b241e6Sjeremylt 
1566a6c615bSJeremy L Thompson #define fCeedVectorTakeArray FORTRAN_NAME(ceedvectortakearray,CEEDVECTORTAKEARRAY)
1576a6c615bSJeremy L Thompson void fCeedVectorTakeArray(int *vec, int *memtype, CeedScalar *array,
1586a6c615bSJeremy L Thompson                           int64_t *offset, int *err) {
1596a6c615bSJeremy L Thompson   CeedScalar *b;
1606a6c615bSJeremy L Thompson   CeedVector vec_ = CeedVector_dict[*vec];
1616a6c615bSJeremy L Thompson   *err = CeedVectorTakeArray(vec_, (CeedMemType)*memtype, &b);
1626a6c615bSJeremy L Thompson   *offset = b - array;
1636a6c615bSJeremy L Thompson }
1646a6c615bSJeremy L Thompson 
16554540941SJeremy L Thompson #define fCeedVectorSyncArray FORTRAN_NAME(ceedvectorsyncarray,CEEDVECTORSYNCARRAY)
16654540941SJeremy L Thompson void fCeedVectorSyncArray(int *vec, int *memtype, int *err) {
167399bb197SJed Brown   *err = CeedVectorSyncArray(CeedVector_dict[*vec], (CeedMemType)*memtype);
16854540941SJeremy L Thompson }
16954540941SJeremy L Thompson 
170d7b241e6Sjeremylt #define fCeedVectorSetValue FORTRAN_NAME(ceedvectorsetvalue,CEEDVECTORSETVALUE)
171d7b241e6Sjeremylt void fCeedVectorSetValue(int *vec, CeedScalar *value, int *err) {
172d7b241e6Sjeremylt   *err = CeedVectorSetValue(CeedVector_dict[*vec], *value);
173d7b241e6Sjeremylt }
174d7b241e6Sjeremylt 
175d7b241e6Sjeremylt #define fCeedVectorGetArray FORTRAN_NAME(ceedvectorgetarray,CEEDVECTORGETARRAY)
176a8de75f0Sjeremylt void fCeedVectorGetArray(int *vec, int *memtype, CeedScalar *array,
1776a6c615bSJeremy L Thompson                          int64_t *offset, int *err) {
178d7b241e6Sjeremylt   CeedScalar *b;
179d7b241e6Sjeremylt   CeedVector vec_ = CeedVector_dict[*vec];
180399bb197SJed Brown   *err = CeedVectorGetArray(vec_, (CeedMemType)*memtype, &b);
181cbfd6a90SThilina Rathnayake   *offset = b - array;
182d7b241e6Sjeremylt }
183d7b241e6Sjeremylt 
184d7b241e6Sjeremylt #define fCeedVectorGetArrayRead \
185d7b241e6Sjeremylt     FORTRAN_NAME(ceedvectorgetarrayread,CEEDVECTORGETARRAYREAD)
186d7b241e6Sjeremylt void fCeedVectorGetArrayRead(int *vec, int *memtype, CeedScalar *array,
1873334379fSJed Brown                              int64_t *offset, int *err) {
188d7b241e6Sjeremylt   const CeedScalar *b;
189d7b241e6Sjeremylt   CeedVector vec_ = CeedVector_dict[*vec];
190399bb197SJed Brown   *err = CeedVectorGetArrayRead(vec_, (CeedMemType)*memtype, &b);
191cbfd6a90SThilina Rathnayake   *offset = b - array;
192d7b241e6Sjeremylt }
193d7b241e6Sjeremylt 
194*9c774eddSJeremy L Thompson #define fCeedVectorGetArrayWrite \
195*9c774eddSJeremy L Thompson     FORTRAN_NAME(ceedvectorgetarraywrite,CEEDVECTORGETARRAYWRITE)
196*9c774eddSJeremy L Thompson void fCeedVectorGetArrayWrite(int *vec, int *memtype, CeedScalar *array,
197*9c774eddSJeremy L Thompson                               int64_t *offset, int *err) {
198*9c774eddSJeremy L Thompson   CeedScalar *b;
199*9c774eddSJeremy L Thompson   CeedVector vec_ = CeedVector_dict[*vec];
200*9c774eddSJeremy L Thompson   *err = CeedVectorGetArrayWrite(vec_, (CeedMemType)*memtype, &b);
201*9c774eddSJeremy L Thompson   *offset = b - array;
202*9c774eddSJeremy L Thompson }
203*9c774eddSJeremy L Thompson 
204d7b241e6Sjeremylt #define fCeedVectorRestoreArray \
205d7b241e6Sjeremylt     FORTRAN_NAME(ceedvectorrestorearray,CEEDVECTORRESTOREARRAY)
2066456524eSJed Brown void fCeedVectorRestoreArray(int *vec, CeedScalar *array,
2076456524eSJed Brown                              int64_t *offset, int *err) {
2089647a07eSDavid Medina   CeedScalar *offsetArray = array + *offset;
2099647a07eSDavid Medina   *err = CeedVectorRestoreArray(CeedVector_dict[*vec], &offsetArray);
2106456524eSJed Brown   *offset = 0;
211d7b241e6Sjeremylt }
212d7b241e6Sjeremylt 
213d7b241e6Sjeremylt #define fCeedVectorRestoreArrayRead \
214d7b241e6Sjeremylt     FORTRAN_NAME(ceedvectorrestorearrayread,CEEDVECTORRESTOREARRAYREAD)
2156456524eSJed Brown void fCeedVectorRestoreArrayRead(int *vec, const CeedScalar *array,
2166456524eSJed Brown                                  int64_t *offset, int *err) {
217d7b241e6Sjeremylt   *err = CeedVectorRestoreArrayRead(CeedVector_dict[*vec], &array);
2186456524eSJed Brown   *offset = 0;
219d7b241e6Sjeremylt }
220d7b241e6Sjeremylt 
221547d9b97Sjeremylt #define fCeedVectorNorm \
222547d9b97Sjeremylt     FORTRAN_NAME(ceedvectornorm,CEEDVECTORNORM)
223547d9b97Sjeremylt void fCeedVectorNorm(int *vec, int *type, CeedScalar *norm, int *err) {
224399bb197SJed Brown   *err = CeedVectorNorm(CeedVector_dict[*vec], (CeedNormType)*type, norm);
225547d9b97Sjeremylt }
226547d9b97Sjeremylt 
227d99fa3c5SJeremy L Thompson #define fCeedVectorReciprocal \
228d99fa3c5SJeremy L Thompson     FORTRAN_NAME(ceedvectorreciprocal,CEEDVECTORRECIPROCAL)
229d99fa3c5SJeremy L Thompson void fCeedVectorReciprocal(int *vec, int *err) {
230d99fa3c5SJeremy L Thompson   *err = CeedVectorReciprocal(CeedVector_dict[*vec]);
231d99fa3c5SJeremy L Thompson }
232d99fa3c5SJeremy L Thompson 
233d7b241e6Sjeremylt #define fCeedVectorView FORTRAN_NAME(ceedvectorview,CEEDVECTORVIEW)
234d7b241e6Sjeremylt void fCeedVectorView(int *vec, int *err) {
235d7b241e6Sjeremylt   *err = CeedVectorView(CeedVector_dict[*vec], "%12.8f", stdout);
236d7b241e6Sjeremylt }
237d7b241e6Sjeremylt 
238d7b241e6Sjeremylt #define fCeedVectorDestroy FORTRAN_NAME(ceedvectordestroy,CEEDVECTORDESTROY)
239d7b241e6Sjeremylt void fCeedVectorDestroy(int *vec, int *err) {
240b22696a8SJeremy L Thompson   if (*vec == FORTRAN_NULL) return;
241d7b241e6Sjeremylt   *err = CeedVectorDestroy(&CeedVector_dict[*vec]);
242d7b241e6Sjeremylt 
243d7b241e6Sjeremylt   if (*err == 0) {
24416595307SJeremy L Thompson     *vec = FORTRAN_NULL;
245d7b241e6Sjeremylt     CeedVector_n--;
246d7b241e6Sjeremylt     if (CeedVector_n == 0) {
247d7b241e6Sjeremylt       CeedFree(&CeedVector_dict);
248d7b241e6Sjeremylt       CeedVector_count = 0;
249d7b241e6Sjeremylt       CeedVector_count_max = 0;
250d7b241e6Sjeremylt     }
251d7b241e6Sjeremylt   }
252d7b241e6Sjeremylt }
253d7b241e6Sjeremylt 
254b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
255b00b43a6SJeremy L Thompson // CeedElemRestriction
256b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
257d7b241e6Sjeremylt static CeedElemRestriction *CeedElemRestriction_dict = NULL;
258d7b241e6Sjeremylt static int CeedElemRestriction_count = 0;
259d7b241e6Sjeremylt static int CeedElemRestriction_n = 0;
260d7b241e6Sjeremylt static int CeedElemRestriction_count_max = 0;
261d7b241e6Sjeremylt 
262d7b241e6Sjeremylt #define fCeedElemRestrictionCreate \
263d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictioncreate, CEEDELEMRESTRICTIONCREATE)
264d979a051Sjeremylt void fCeedElemRestrictionCreate(int *ceed, int *nelements, int *esize,
265d1d35e2fSjeremylt                                 int *num_comp, int *comp_stride, int *lsize,
266d979a051Sjeremylt                                 int *memtype, int *copymode, const int *offsets,
2678795c945Sjeremylt                                 int *elemrestriction, int *err) {
268d7b241e6Sjeremylt   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
269d7b241e6Sjeremylt     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
270d7b241e6Sjeremylt     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
271d7b241e6Sjeremylt   }
272d7b241e6Sjeremylt 
273d979a051Sjeremylt   const int *offsets_ = offsets;
274d7b241e6Sjeremylt 
275d7b241e6Sjeremylt   CeedElemRestriction *elemrestriction_ =
276d7b241e6Sjeremylt     &CeedElemRestriction_dict[CeedElemRestriction_count];
277d979a051Sjeremylt   *err = CeedElemRestrictionCreate(Ceed_dict[*ceed], *nelements, *esize,
278d1d35e2fSjeremylt                                    *num_comp, *comp_stride, *lsize,
279d979a051Sjeremylt                                    (CeedMemType)*memtype,
280d979a051Sjeremylt                                    (CeedCopyMode)*copymode, offsets_,
281d979a051Sjeremylt                                    elemrestriction_);
282d7b241e6Sjeremylt 
283d7b241e6Sjeremylt   if (*err == 0) {
284d7b241e6Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
285d7b241e6Sjeremylt     CeedElemRestriction_n++;
286d7b241e6Sjeremylt   }
287d7b241e6Sjeremylt }
288d7b241e6Sjeremylt 
2897509a596Sjeremylt #define fCeedElemRestrictionCreateStrided \
2907509a596Sjeremylt     FORTRAN_NAME(ceedelemrestrictioncreatestrided, CEEDELEMRESTRICTIONCREATESTRIDED)
2917509a596Sjeremylt void fCeedElemRestrictionCreateStrided(int *ceed, int *nelements, int *esize,
292d1d35e2fSjeremylt                                        int *num_comp, int *lsize, int *strides,
293d7b241e6Sjeremylt                                        int *elemrestriction, int *err) {
294d7b241e6Sjeremylt   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
295d7b241e6Sjeremylt     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
296d7b241e6Sjeremylt     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
297d7b241e6Sjeremylt   }
298d7b241e6Sjeremylt 
299d7b241e6Sjeremylt   CeedElemRestriction *elemrestriction_ =
300d7b241e6Sjeremylt     &CeedElemRestriction_dict[CeedElemRestriction_count];
3017509a596Sjeremylt   *err = CeedElemRestrictionCreateStrided(Ceed_dict[*ceed], *nelements, *esize,
302d1d35e2fSjeremylt                                           *num_comp, *lsize,
303d979a051Sjeremylt                                           *strides == FORTRAN_STRIDES_BACKEND ?
304d979a051Sjeremylt                                           CEED_STRIDES_BACKEND : strides,
305523b8ea0Sjeremylt                                           elemrestriction_);
306d7b241e6Sjeremylt   if (*err == 0) {
307d7b241e6Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
308d7b241e6Sjeremylt     CeedElemRestriction_n++;
309d7b241e6Sjeremylt   }
310d7b241e6Sjeremylt }
311d7b241e6Sjeremylt 
312d7b241e6Sjeremylt #define fCeedElemRestrictionCreateBlocked \
313d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictioncreateblocked,CEEDELEMRESTRICTIONCREATEBLOCKED)
314d979a051Sjeremylt void fCeedElemRestrictionCreateBlocked(int *ceed, int *nelements, int *esize,
315d1d35e2fSjeremylt                                        int *blocksize, int *num_comp,
316d1d35e2fSjeremylt                                        int *comp_stride, int *lsize,
317d979a051Sjeremylt                                        int *mtype, int *cmode,
3188795c945Sjeremylt                                        int *blkindices, int *elemrestriction,
3198795c945Sjeremylt                                        int *err) {
320d7b241e6Sjeremylt 
321d7b241e6Sjeremylt   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
322d7b241e6Sjeremylt     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
323d7b241e6Sjeremylt     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
324d7b241e6Sjeremylt   }
325d7b241e6Sjeremylt 
326d7b241e6Sjeremylt   CeedElemRestriction *elemrestriction_ =
327d7b241e6Sjeremylt     &CeedElemRestriction_dict[CeedElemRestriction_count];
328399bb197SJed Brown   *err = CeedElemRestrictionCreateBlocked(Ceed_dict[*ceed],
329d979a051Sjeremylt                                           *nelements, *esize, *blocksize,
330d1d35e2fSjeremylt                                           *num_comp, *comp_stride, *lsize,
331d979a051Sjeremylt                                           (CeedMemType)*mtype,
332d979a051Sjeremylt                                           (CeedCopyMode)*cmode, blkindices,
333a8d32208Sjeremylt                                           elemrestriction_);
334d7b241e6Sjeremylt 
335d7b241e6Sjeremylt   if (*err == 0) {
336d7b241e6Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
337d7b241e6Sjeremylt     CeedElemRestriction_n++;
338d7b241e6Sjeremylt   }
339d7b241e6Sjeremylt }
340d7b241e6Sjeremylt 
3417509a596Sjeremylt #define fCeedElemRestrictionCreateBlockedStrided \
3427509a596Sjeremylt     FORTRAN_NAME(ceedelemrestrictioncreateblockedstrided, CEEDELEMRESTRICTIONCREATEBLOCKEDSTRIDED)
3437509a596Sjeremylt void fCeedElemRestrictionCreateBlockedStrided(int *ceed, int *nelements,
344d1d35e2fSjeremylt     int *esize, int *blk_size, int *num_comp, int *lsize, int *strides,
3457509a596Sjeremylt     int *elemrestriction, int *err) {
3467509a596Sjeremylt   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
3477509a596Sjeremylt     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
3487509a596Sjeremylt     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
3497509a596Sjeremylt   }
3507509a596Sjeremylt 
3517509a596Sjeremylt   CeedElemRestriction *elemrestriction_ =
3527509a596Sjeremylt     &CeedElemRestriction_dict[CeedElemRestriction_count];
3537509a596Sjeremylt   *err = CeedElemRestrictionCreateBlockedStrided(Ceed_dict[*ceed], *nelements,
354d1d35e2fSjeremylt          *esize, *blk_size, *num_comp, *lsize, strides, elemrestriction_);
3557509a596Sjeremylt   if (*err == 0) {
3567509a596Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
3577509a596Sjeremylt     CeedElemRestriction_n++;
3587509a596Sjeremylt   }
3597509a596Sjeremylt }
3607509a596Sjeremylt 
361d7b241e6Sjeremylt static CeedRequest *CeedRequest_dict = NULL;
362d7b241e6Sjeremylt static int CeedRequest_count = 0;
363d7b241e6Sjeremylt static int CeedRequest_n = 0;
364d7b241e6Sjeremylt static int CeedRequest_count_max = 0;
365d7b241e6Sjeremylt 
366d7b241e6Sjeremylt #define fCeedElemRestrictionApply \
367d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictionapply,CEEDELEMRESTRICTIONAPPLY)
368a8d32208Sjeremylt void fCeedElemRestrictionApply(int *elemr, int *tmode, int *uvec, int *ruvec,
369a8d32208Sjeremylt                                int *rqst, int *err) {
370d7b241e6Sjeremylt   int createRequest = 1;
371d7b241e6Sjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
372d7b241e6Sjeremylt   if (*rqst == FORTRAN_REQUEST_IMMEDIATE || *rqst == FORTRAN_REQUEST_ORDERED)
373d7b241e6Sjeremylt     createRequest = 0;
374d7b241e6Sjeremylt 
375d7b241e6Sjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
376d7b241e6Sjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
377d7b241e6Sjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
378d7b241e6Sjeremylt   }
379d7b241e6Sjeremylt 
380d7b241e6Sjeremylt   CeedRequest *rqst_;
381d7b241e6Sjeremylt   if      (*rqst == FORTRAN_REQUEST_IMMEDIATE) rqst_ = CEED_REQUEST_IMMEDIATE;
382d7b241e6Sjeremylt   else if (*rqst == FORTRAN_REQUEST_ORDERED  ) rqst_ = CEED_REQUEST_ORDERED;
383d7b241e6Sjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
384d7b241e6Sjeremylt 
385399bb197SJed Brown   *err = CeedElemRestrictionApply(CeedElemRestriction_dict[*elemr],
386399bb197SJed Brown                                   (CeedTransposeMode)*tmode,
387a8d32208Sjeremylt                                   CeedVector_dict[*uvec],
3888795c945Sjeremylt                                   CeedVector_dict[*ruvec], rqst_);
389d7b241e6Sjeremylt 
390d7b241e6Sjeremylt   if (*err == 0 && createRequest) {
391d7b241e6Sjeremylt     *rqst = CeedRequest_count++;
392d7b241e6Sjeremylt     CeedRequest_n++;
393d7b241e6Sjeremylt   }
394d7b241e6Sjeremylt }
395d7b241e6Sjeremylt 
396be9261b7Sjeremylt #define fCeedElemRestrictionApplyBlock \
397be9261b7Sjeremylt     FORTRAN_NAME(ceedelemrestrictionapplyblock,CEEDELEMRESTRICTIONAPPLYBLOCK)
398f90c8643Sjeremylt void fCeedElemRestrictionApplyBlock(int *elemr, int *block, int *tmode,
399be9261b7Sjeremylt                                     int *uvec, int *ruvec, int *rqst, int *err) {
400be9261b7Sjeremylt   int createRequest = 1;
401be9261b7Sjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
402be9261b7Sjeremylt   if (*rqst == FORTRAN_REQUEST_IMMEDIATE || *rqst == FORTRAN_REQUEST_ORDERED)
403be9261b7Sjeremylt     createRequest = 0;
404be9261b7Sjeremylt 
405be9261b7Sjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
406be9261b7Sjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
407be9261b7Sjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
408be9261b7Sjeremylt   }
409be9261b7Sjeremylt 
410be9261b7Sjeremylt   CeedRequest *rqst_;
411be9261b7Sjeremylt   if      (*rqst == FORTRAN_REQUEST_IMMEDIATE) rqst_ = CEED_REQUEST_IMMEDIATE;
412be9261b7Sjeremylt   else if (*rqst == FORTRAN_REQUEST_ORDERED  ) rqst_ = CEED_REQUEST_ORDERED;
413be9261b7Sjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
414be9261b7Sjeremylt 
415be9261b7Sjeremylt   *err = CeedElemRestrictionApplyBlock(CeedElemRestriction_dict[*elemr], *block,
416399bb197SJed Brown                                        (CeedTransposeMode)*tmode, CeedVector_dict[*uvec],
417be9261b7Sjeremylt                                        CeedVector_dict[*ruvec], rqst_);
418be9261b7Sjeremylt 
419be9261b7Sjeremylt   if (*err == 0 && createRequest) {
420be9261b7Sjeremylt     *rqst = CeedRequest_count++;
421be9261b7Sjeremylt     CeedRequest_n++;
422be9261b7Sjeremylt   }
423be9261b7Sjeremylt }
424be9261b7Sjeremylt 
4251469ee4dSjeremylt #define fCeedElemRestrictionGetMultiplicity \
4261469ee4dSjeremylt     FORTRAN_NAME(ceedelemrestrictiongetmultiplicity,CEEDELEMRESTRICTIONGETMULTIPLICITY)
427a8d32208Sjeremylt void fCeedElemRestrictionGetMultiplicity(int *elemr, int *mult, int *err) {
4281469ee4dSjeremylt   *err = CeedElemRestrictionGetMultiplicity(CeedElemRestriction_dict[*elemr],
429a8d32208Sjeremylt          CeedVector_dict[*mult]);
4301469ee4dSjeremylt }
4311469ee4dSjeremylt 
43249fd234cSJeremy L Thompson #define fCeedElemRestrictionGetELayout \
43349fd234cSJeremy L Thompson     FORTRAN_NAME(ceedelemrestrictiongetelayout,CEEDELEMRESTRICTIONGETELAYOUT)
43449fd234cSJeremy L Thompson void fCeedElemRestrictionGetELayout(int *elemr, int *layout, int *err) {
43549fd234cSJeremy L Thompson   CeedInt layout_c[3];
43649fd234cSJeremy L Thompson   *err = CeedElemRestrictionGetELayout(CeedElemRestriction_dict[*elemr],
43749fd234cSJeremy L Thompson                                        &layout_c);
43849fd234cSJeremy L Thompson   for (int i=0; i<3; i++)
43949fd234cSJeremy L Thompson     layout[i] = layout_c[i];
44049fd234cSJeremy L Thompson }
44149fd234cSJeremy L Thompson 
4425a86f033Sjeremylt #define fCeedElemRestrictionView \
4435a86f033Sjeremylt     FORTRAN_NAME(ceedelemrestrictionview,CEEDELEMRESTRICTIONVIEW)
4445a86f033Sjeremylt void fCeedElemRestrictionView(int *elemr, int *err) {
4455a86f033Sjeremylt   *err = CeedElemRestrictionView(CeedElemRestriction_dict[*elemr], stdout);
4465a86f033Sjeremylt }
4471469ee4dSjeremylt 
448d7b241e6Sjeremylt #define fCeedRequestWait FORTRAN_NAME(ceedrequestwait, CEEDREQUESTWAIT)
449d7b241e6Sjeremylt void fCeedRequestWait(int *rqst, int *err) {
450d7b241e6Sjeremylt   // TODO Uncomment this once CeedRequestWait is implemented
451d7b241e6Sjeremylt   //*err = CeedRequestWait(&CeedRequest_dict[*rqst]);
452d7b241e6Sjeremylt 
453d7b241e6Sjeremylt   if (*err == 0) {
454d7b241e6Sjeremylt     CeedRequest_n--;
455d7b241e6Sjeremylt     if (CeedRequest_n == 0) {
456d7b241e6Sjeremylt       CeedFree(&CeedRequest_dict);
457d7b241e6Sjeremylt       CeedRequest_count = 0;
458d7b241e6Sjeremylt       CeedRequest_count_max = 0;
459d7b241e6Sjeremylt     }
460d7b241e6Sjeremylt   }
461d7b241e6Sjeremylt }
462d7b241e6Sjeremylt 
463d7b241e6Sjeremylt #define fCeedElemRestrictionDestroy \
464d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictiondestroy,CEEDELEMRESTRICTIONDESTROY)
465d7b241e6Sjeremylt void fCeedElemRestrictionDestroy(int *elem, int *err) {
466b22696a8SJeremy L Thompson   if (*elem == FORTRAN_NULL) return;
467d7b241e6Sjeremylt   *err = CeedElemRestrictionDestroy(&CeedElemRestriction_dict[*elem]);
468d7b241e6Sjeremylt 
469d7b241e6Sjeremylt   if (*err == 0) {
47016595307SJeremy L Thompson     *elem = FORTRAN_NULL;
471d7b241e6Sjeremylt     CeedElemRestriction_n--;
472d7b241e6Sjeremylt     if (CeedElemRestriction_n == 0) {
473d7b241e6Sjeremylt       CeedFree(&CeedElemRestriction_dict);
474d7b241e6Sjeremylt       CeedElemRestriction_count = 0;
475d7b241e6Sjeremylt       CeedElemRestriction_count_max = 0;
476d7b241e6Sjeremylt     }
477d7b241e6Sjeremylt   }
478d7b241e6Sjeremylt }
479d7b241e6Sjeremylt 
480b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
481b00b43a6SJeremy L Thompson // CeedBasis
482b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
483d7b241e6Sjeremylt static CeedBasis *CeedBasis_dict = NULL;
484d7b241e6Sjeremylt static int CeedBasis_count = 0;
485d7b241e6Sjeremylt static int CeedBasis_n = 0;
486d7b241e6Sjeremylt static int CeedBasis_count_max = 0;
487d7b241e6Sjeremylt 
488d7b241e6Sjeremylt #define fCeedBasisCreateTensorH1Lagrange \
489d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasiscreatetensorh1lagrange, CEEDBASISCREATETENSORH1LAGRANGE)
490d7b241e6Sjeremylt void fCeedBasisCreateTensorH1Lagrange(int *ceed, int *dim,
491d1d35e2fSjeremylt                                       int *num_comp, int *P, int *Q, int *quadmode,
4928795c945Sjeremylt                                       int *basis, int *err) {
493d7b241e6Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
494d7b241e6Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
495d7b241e6Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
496d7b241e6Sjeremylt   }
497d7b241e6Sjeremylt 
498d1d35e2fSjeremylt   *err = CeedBasisCreateTensorH1Lagrange(Ceed_dict[*ceed], *dim, *num_comp, *P,
499d1d35e2fSjeremylt                                          *Q,
500399bb197SJed Brown                                          (CeedQuadMode)*quadmode,
5018795c945Sjeremylt                                          &CeedBasis_dict[CeedBasis_count]);
502d7b241e6Sjeremylt 
503d7b241e6Sjeremylt   if (*err == 0) {
504d7b241e6Sjeremylt     *basis = CeedBasis_count++;
505d7b241e6Sjeremylt     CeedBasis_n++;
506d7b241e6Sjeremylt   }
507d7b241e6Sjeremylt }
508d7b241e6Sjeremylt 
509d7b241e6Sjeremylt #define fCeedBasisCreateTensorH1 \
510d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasiscreatetensorh1, CEEDBASISCREATETENSORH1)
511d1d35e2fSjeremylt void fCeedBasisCreateTensorH1(int *ceed, int *dim, int *num_comp, int *P_1d,
512d1d35e2fSjeremylt                               int *Q_1d, const CeedScalar *interp_1d,
513d1d35e2fSjeremylt                               const CeedScalar *grad_1d,
514d1d35e2fSjeremylt                               const CeedScalar *q_ref_1d,
515d1d35e2fSjeremylt                               const CeedScalar *q_weight_1d, int *basis,
5168795c945Sjeremylt                               int *err) {
517d7b241e6Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
518d7b241e6Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
519d7b241e6Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
520d7b241e6Sjeremylt   }
521d7b241e6Sjeremylt 
522d1d35e2fSjeremylt   *err = CeedBasisCreateTensorH1(Ceed_dict[*ceed], *dim, *num_comp, *P_1d, *Q_1d,
523d1d35e2fSjeremylt                                  interp_1d, grad_1d, q_ref_1d, q_weight_1d,
5248795c945Sjeremylt                                  &CeedBasis_dict[CeedBasis_count]);
525d7b241e6Sjeremylt 
526d7b241e6Sjeremylt   if (*err == 0) {
527d7b241e6Sjeremylt     *basis = CeedBasis_count++;
528d7b241e6Sjeremylt     CeedBasis_n++;
529d7b241e6Sjeremylt   }
530d7b241e6Sjeremylt }
531d7b241e6Sjeremylt 
532a8de75f0Sjeremylt #define fCeedBasisCreateH1 \
533a8de75f0Sjeremylt     FORTRAN_NAME(ceedbasiscreateh1, CEEDBASISCREATEH1)
534d1d35e2fSjeremylt void fCeedBasisCreateH1(int *ceed, int *topo, int *num_comp, int *nnodes,
5358795c945Sjeremylt                         int *nqpts, const CeedScalar *interp,
5368795c945Sjeremylt                         const CeedScalar *grad, const CeedScalar *qref,
5378795c945Sjeremylt                         const CeedScalar *qweight, int *basis, int *err) {
538a8de75f0Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
539a8de75f0Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
540a8de75f0Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
541a8de75f0Sjeremylt   }
542a8de75f0Sjeremylt 
543d1d35e2fSjeremylt   *err = CeedBasisCreateH1(Ceed_dict[*ceed], (CeedElemTopology)*topo, *num_comp,
544399bb197SJed Brown                            *nnodes, *nqpts, interp, grad, qref, qweight,
5458795c945Sjeremylt                            &CeedBasis_dict[CeedBasis_count]);
546a8de75f0Sjeremylt 
547a8de75f0Sjeremylt   if (*err == 0) {
548a8de75f0Sjeremylt     *basis = CeedBasis_count++;
549a8de75f0Sjeremylt     CeedBasis_n++;
550a8de75f0Sjeremylt   }
551a8de75f0Sjeremylt }
552a8de75f0Sjeremylt 
553d7b241e6Sjeremylt #define fCeedBasisView FORTRAN_NAME(ceedbasisview, CEEDBASISVIEW)
554d7b241e6Sjeremylt void fCeedBasisView(int *basis, int *err) {
555d7b241e6Sjeremylt   *err = CeedBasisView(CeedBasis_dict[*basis], stdout);
556d7b241e6Sjeremylt }
557d7b241e6Sjeremylt 
558d7b241e6Sjeremylt #define fCeedQRFactorization \
559d7b241e6Sjeremylt     FORTRAN_NAME(ceedqrfactorization, CEEDQRFACTORIZATION)
560a7bd39daSjeremylt void fCeedQRFactorization(int *ceed, CeedScalar *mat, CeedScalar *tau, int *m,
561a7bd39daSjeremylt                           int *n, int *err) {
562a7bd39daSjeremylt   *err = CeedQRFactorization(Ceed_dict[*ceed], mat, tau, *m, *n);
563d7b241e6Sjeremylt }
564d7b241e6Sjeremylt 
5659ac7b42eSJeremy L Thompson #define fCeedHouseholderApplyQ \
5669ac7b42eSJeremy L Thompson     FORTRAN_NAME(ceedhouseholderapplyq, CEEDHOUSEHOLDERAPPLYQ)
5679ac7b42eSJeremy L Thompson void fCeedHouseholderApplyQ(CeedScalar *A, CeedScalar *Q, CeedScalar *tau,
5689ac7b42eSJeremy L Thompson                             int *t_mode,
5699ac7b42eSJeremy L Thompson                             int *m, int *n, int *k, int *row, int *col, int *err) {
5709ac7b42eSJeremy L Thompson   *err = CeedHouseholderApplyQ(A, Q, tau, (CeedTransposeMode)*t_mode, *m, *n, *k,
5719ac7b42eSJeremy L Thompson                                *row, *col);
5729ac7b42eSJeremy L Thompson }
5739ac7b42eSJeremy L Thompson 
57452bfb9bbSJeremy L Thompson #define fCeedSymmetricSchurDecomposition \
57552bfb9bbSJeremy L Thompson     FORTRAN_NAME(ceedsymmetricschurdecomposition, CEEDSYMMETRICSCHURDECOMPOSITION)
57652bfb9bbSJeremy L Thompson void fCeedSymmetricSchurDecomposition(int *ceed, CeedScalar *mat,
57752bfb9bbSJeremy L Thompson                                       CeedScalar *lambda, int *n, int *err) {
57852bfb9bbSJeremy L Thompson   *err = CeedSymmetricSchurDecomposition(Ceed_dict[*ceed], mat, lambda, *n);
57952bfb9bbSJeremy L Thompson }
58052bfb9bbSJeremy L Thompson 
58152bfb9bbSJeremy L Thompson #define fCeedSimultaneousDiagonalization \
58252bfb9bbSJeremy L Thompson     FORTRAN_NAME(ceedsimultaneousdiagonalization, CEEDSIMULTANEOUSDIAGONALIZATION)
58352bfb9bbSJeremy L Thompson void fCeedSimultaneousDiagonalization(int *ceed, CeedScalar *matA,
58452bfb9bbSJeremy L Thompson                                       CeedScalar *matB, CeedScalar *x,
58552bfb9bbSJeremy L Thompson                                       CeedScalar *lambda, int *n, int *err) {
58652bfb9bbSJeremy L Thompson   *err = CeedSimultaneousDiagonalization(Ceed_dict[*ceed], matA, matB, x,
58752bfb9bbSJeremy L Thompson                                          lambda, *n);
58852bfb9bbSJeremy L Thompson }
58952bfb9bbSJeremy L Thompson 
590783c99b3SValeria Barra #define fCeedBasisGetCollocatedGrad \
591783c99b3SValeria Barra     FORTRAN_NAME(ceedbasisgetcollocatedgrad, CEEDBASISGETCOLLOCATEDGRAD)
592d1d35e2fSjeremylt void fCeedBasisGetCollocatedGrad(int *basis, CeedScalar *colo_grad_1d,
593d7b241e6Sjeremylt                                  int *err) {
594d1d35e2fSjeremylt   *err = CeedBasisGetCollocatedGrad(CeedBasis_dict[*basis], colo_grad_1d);
595d7b241e6Sjeremylt }
596d7b241e6Sjeremylt 
597d7b241e6Sjeremylt #define fCeedBasisApply FORTRAN_NAME(ceedbasisapply, CEEDBASISAPPLY)
598d1d35e2fSjeremylt void fCeedBasisApply(int *basis, int *num_elem, int *tmode, int *eval_mode,
599aedaa0e5Sjeremylt                      int *u, int *v, int *err) {
600d1d35e2fSjeremylt   *err = CeedBasisApply(CeedBasis_dict[*basis], *num_elem,
601d1d35e2fSjeremylt                         (CeedTransposeMode)*tmode,
602d1d35e2fSjeremylt                         (CeedEvalMode)*eval_mode,
603399bb197SJed Brown                         *u == FORTRAN_VECTOR_NONE ? CEED_VECTOR_NONE : CeedVector_dict[*u],
604aedaa0e5Sjeremylt                         CeedVector_dict[*v]);
605d7b241e6Sjeremylt }
606d7b241e6Sjeremylt 
607d7b241e6Sjeremylt #define fCeedBasisGetNumNodes \
608d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasisgetnumnodes, CEEDBASISGETNUMNODES)
609d7b241e6Sjeremylt void fCeedBasisGetNumNodes(int *basis, int *P, int *err) {
610d7b241e6Sjeremylt   *err = CeedBasisGetNumNodes(CeedBasis_dict[*basis], P);
611d7b241e6Sjeremylt }
612d7b241e6Sjeremylt 
613d7b241e6Sjeremylt #define fCeedBasisGetNumQuadraturePoints \
614d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasisgetnumquadraturepoints, CEEDBASISGETNUMQUADRATUREPOINTS)
615d7b241e6Sjeremylt void fCeedBasisGetNumQuadraturePoints(int *basis, int *Q, int *err) {
616d7b241e6Sjeremylt   *err = CeedBasisGetNumQuadraturePoints(CeedBasis_dict[*basis], Q);
617d7b241e6Sjeremylt }
618d7b241e6Sjeremylt 
619d99fa3c5SJeremy L Thompson #define fCeedBasisGetInterp1D \
620d99fa3c5SJeremy L Thompson     FORTRAN_NAME(ceedbasisgetinterp1d, CEEDBASISGETINTERP1D)
621d1d35e2fSjeremylt void fCeedBasisGetInterp1D(int *basis, CeedScalar *interp_1d, int64_t *offset,
622d99fa3c5SJeremy L Thompson                            int *err) {
623d99fa3c5SJeremy L Thompson   const CeedScalar *interp1d_;
624d99fa3c5SJeremy L Thompson   CeedBasis basis_ = CeedBasis_dict[*basis];
625d99fa3c5SJeremy L Thompson   *err = CeedBasisGetInterp1D(basis_, &interp1d_);
626d1d35e2fSjeremylt   *offset = interp1d_ - interp_1d;
627d99fa3c5SJeremy L Thompson }
628d99fa3c5SJeremy L Thompson 
6299ac7b42eSJeremy L Thompson #define fCeedBasisGetGrad1D \
6309ac7b42eSJeremy L Thompson     FORTRAN_NAME(ceedbasisgetgrad1d, CEEDBASISGETGRAD1D)
6319ac7b42eSJeremy L Thompson void fCeedBasisGetGrad1D(int *basis, CeedScalar *grad_1d, int64_t *offset,
6329ac7b42eSJeremy L Thompson                          int *err) {
6339ac7b42eSJeremy L Thompson   const CeedScalar *grad1d_;
6349ac7b42eSJeremy L Thompson   CeedBasis basis_ = CeedBasis_dict[*basis];
6359ac7b42eSJeremy L Thompson   *err = CeedBasisGetGrad1D(basis_, &grad1d_);
6369ac7b42eSJeremy L Thompson   *offset = grad1d_ - grad_1d;
6379ac7b42eSJeremy L Thompson }
6389ac7b42eSJeremy L Thompson 
6399ac7b42eSJeremy L Thompson #define fCeedBasisGetQRef \
6409ac7b42eSJeremy L Thompson     FORTRAN_NAME(ceedbasisgetqref, CEEDBASISGETQREF)
6419ac7b42eSJeremy L Thompson void fCeedBasisGetQRef(int *basis, CeedScalar *q_ref, int64_t *offset,
6429ac7b42eSJeremy L Thompson                        int *err) {
6439ac7b42eSJeremy L Thompson   const CeedScalar *qref_;
6449ac7b42eSJeremy L Thompson   CeedBasis basis_ = CeedBasis_dict[*basis];
6459ac7b42eSJeremy L Thompson   *err = CeedBasisGetQRef(basis_, &qref_);
6469ac7b42eSJeremy L Thompson   *offset = qref_ - q_ref;
6479ac7b42eSJeremy L Thompson }
6489ac7b42eSJeremy L Thompson 
649d7b241e6Sjeremylt #define fCeedBasisDestroy FORTRAN_NAME(ceedbasisdestroy,CEEDBASISDESTROY)
650d7b241e6Sjeremylt void fCeedBasisDestroy(int *basis, int *err) {
651b22696a8SJeremy L Thompson   if (*basis == FORTRAN_NULL) return;
652d7b241e6Sjeremylt   *err = CeedBasisDestroy(&CeedBasis_dict[*basis]);
653d7b241e6Sjeremylt 
654d7b241e6Sjeremylt   if (*err == 0) {
65516595307SJeremy L Thompson     *basis = FORTRAN_NULL;
656d7b241e6Sjeremylt     CeedBasis_n--;
657d7b241e6Sjeremylt     if (CeedBasis_n == 0) {
658d7b241e6Sjeremylt       CeedFree(&CeedBasis_dict);
659d7b241e6Sjeremylt       CeedBasis_count = 0;
660d7b241e6Sjeremylt       CeedBasis_count_max = 0;
661d7b241e6Sjeremylt     }
662d7b241e6Sjeremylt   }
663d7b241e6Sjeremylt }
664d7b241e6Sjeremylt 
665d7b241e6Sjeremylt #define fCeedGaussQuadrature FORTRAN_NAME(ceedgaussquadrature, CEEDGAUSSQUADRATURE)
666d1d35e2fSjeremylt void fCeedGaussQuadrature(int *Q, CeedScalar *q_ref_1d, CeedScalar *q_weight_1d,
667d7b241e6Sjeremylt                           int *err) {
668d1d35e2fSjeremylt   *err = CeedGaussQuadrature(*Q, q_ref_1d, q_weight_1d);
669d7b241e6Sjeremylt }
670d7b241e6Sjeremylt 
671d7b241e6Sjeremylt #define fCeedLobattoQuadrature \
672d7b241e6Sjeremylt     FORTRAN_NAME(ceedlobattoquadrature, CEEDLOBATTOQUADRATURE)
673d1d35e2fSjeremylt void fCeedLobattoQuadrature(int *Q, CeedScalar *q_ref_1d,
674d1d35e2fSjeremylt                             CeedScalar *q_weight_1d,
675d7b241e6Sjeremylt                             int *err) {
676d1d35e2fSjeremylt   *err = CeedLobattoQuadrature(*Q, q_ref_1d, q_weight_1d);
677d7b241e6Sjeremylt }
678d7b241e6Sjeremylt 
679b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
680777ff853SJeremy L Thompson // CeedQFunctionContext
681777ff853SJeremy L Thompson // -----------------------------------------------------------------------------
682777ff853SJeremy L Thompson static CeedQFunctionContext *CeedQFunctionContext_dict = NULL;
683777ff853SJeremy L Thompson static int CeedQFunctionContext_count = 0;
684777ff853SJeremy L Thompson static int CeedQFunctionContext_n = 0;
685777ff853SJeremy L Thompson static int CeedQFunctionContext_count_max = 0;
686777ff853SJeremy L Thompson 
687777ff853SJeremy L Thompson #define fCeedQFunctionContextCreate \
688777ff853SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncontextcreate,CEEDQFUNCTIONCONTEXTCREATE)
689777ff853SJeremy L Thompson void fCeedQFunctionContextCreate(int *ceed, int *ctx, int *err) {
690777ff853SJeremy L Thompson   if (CeedQFunctionContext_count == CeedQFunctionContext_count_max) {
691777ff853SJeremy L Thompson     CeedQFunctionContext_count_max += CeedQFunctionContext_count_max/2 + 1;
692777ff853SJeremy L Thompson     CeedRealloc(CeedQFunctionContext_count_max, &CeedQFunctionContext_dict);
693777ff853SJeremy L Thompson   }
694777ff853SJeremy L Thompson 
695777ff853SJeremy L Thompson   CeedQFunctionContext *ctx_ =
696777ff853SJeremy L Thompson     &CeedQFunctionContext_dict[CeedQFunctionContext_count];
697777ff853SJeremy L Thompson 
698777ff853SJeremy L Thompson   *err = CeedQFunctionContextCreate(Ceed_dict[*ceed], ctx_);
699777ff853SJeremy L Thompson   if (*err) return;
700777ff853SJeremy L Thompson   *ctx = CeedQFunctionContext_count++;
701777ff853SJeremy L Thompson   CeedQFunctionContext_n++;
702777ff853SJeremy L Thompson }
703777ff853SJeremy L Thompson 
704777ff853SJeremy L Thompson #define fCeedQFunctionContextSetData \
705777ff853SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncontextsetdata,CEEDQFUNCTIONCONTEXTSETDATA)
706777ff853SJeremy L Thompson void fCeedQFunctionContextSetData(int *ctx, int *memtype, int *copymode,
707777ff853SJeremy L Thompson                                   CeedInt *n,
708777ff853SJeremy L Thompson                                   CeedScalar *data, int64_t *offset, int *err) {
709d1d35e2fSjeremylt   size_t ctx_size = ((size_t) *n)*sizeof(CeedScalar);
710777ff853SJeremy L Thompson   *err = CeedQFunctionContextSetData(CeedQFunctionContext_dict[*ctx],
711777ff853SJeremy L Thompson                                      (CeedMemType)*memtype,
712d1d35e2fSjeremylt                                      (CeedCopyMode)*copymode, ctx_size,
713777ff853SJeremy L Thompson                                      data + *offset);
714777ff853SJeremy L Thompson }
715777ff853SJeremy L Thompson 
716777ff853SJeremy L Thompson #define fCeedQFunctionContextGetData \
717777ff853SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncontextgetdata,CEEDQFUNCTIONCONTEXTGETDATA)
718777ff853SJeremy L Thompson void fCeedQFunctionContextGetData(int *ctx, int *memtype, CeedScalar *data,
719777ff853SJeremy L Thompson                                   int64_t *offset, int *err) {
720777ff853SJeremy L Thompson   CeedScalar *b;
721777ff853SJeremy L Thompson   CeedQFunctionContext ctx_ = CeedQFunctionContext_dict[*ctx];
722777ff853SJeremy L Thompson   *err = CeedQFunctionContextGetData(ctx_, (CeedMemType)*memtype, &b);
723777ff853SJeremy L Thompson   *offset = b - data;
724777ff853SJeremy L Thompson }
725777ff853SJeremy L Thompson 
726777ff853SJeremy L Thompson #define fCeedQFunctionContextRestoreData \
727777ff853SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncontextrestoredata,CEEDQFUNCTIONCONTEXTRESTOREDATA)
728777ff853SJeremy L Thompson void fCeedQFunctionContextRestoreData(int *ctx, CeedScalar *data,
729777ff853SJeremy L Thompson                                       int64_t *offset, int *err) {
730777ff853SJeremy L Thompson   *err = CeedQFunctionContextRestoreData(CeedQFunctionContext_dict[*ctx],
731777ff853SJeremy L Thompson                                          (void **)&data);
732777ff853SJeremy L Thompson   *offset = 0;
733777ff853SJeremy L Thompson }
734777ff853SJeremy L Thompson 
735777ff853SJeremy L Thompson #define fCeedQFunctionContextView \
736777ff853SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncontextview,CEEDQFUNCTIONCONTEXTVIEW)
737777ff853SJeremy L Thompson void fCeedQFunctionContextView(int *ctx, int *err) {
738777ff853SJeremy L Thompson   *err = CeedQFunctionContextView(CeedQFunctionContext_dict[*ctx], stdout);
739777ff853SJeremy L Thompson }
740777ff853SJeremy L Thompson 
741777ff853SJeremy L Thompson #define fCeedQFunctionContextDestroy \
742777ff853SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncontextdestroy,CEEDQFUNCTIONCONTEXTDESTROY)
743777ff853SJeremy L Thompson void fCeedQFunctionContextDestroy(int *ctx, int *err) {
744777ff853SJeremy L Thompson   if (*ctx == FORTRAN_NULL) return;
745777ff853SJeremy L Thompson   *err = CeedQFunctionContextDestroy(&CeedQFunctionContext_dict[*ctx]);
746777ff853SJeremy L Thompson 
747777ff853SJeremy L Thompson   if (*err == 0) {
748777ff853SJeremy L Thompson     *ctx = FORTRAN_NULL;
749777ff853SJeremy L Thompson     CeedQFunctionContext_n--;
750777ff853SJeremy L Thompson     if (CeedQFunctionContext_n == 0) {
751777ff853SJeremy L Thompson       CeedFree(&CeedQFunctionContext_dict);
752777ff853SJeremy L Thompson       CeedQFunctionContext_count = 0;
753777ff853SJeremy L Thompson       CeedQFunctionContext_count_max = 0;
754777ff853SJeremy L Thompson     }
755777ff853SJeremy L Thompson   }
756777ff853SJeremy L Thompson }
757777ff853SJeremy L Thompson 
758777ff853SJeremy L Thompson // -----------------------------------------------------------------------------
759b00b43a6SJeremy L Thompson // CeedQFunction
760b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
761d7b241e6Sjeremylt static CeedQFunction *CeedQFunction_dict = NULL;
762d7b241e6Sjeremylt static int CeedQFunction_count = 0;
763d7b241e6Sjeremylt static int CeedQFunction_n = 0;
764d7b241e6Sjeremylt static int CeedQFunction_count_max = 0;
765d7b241e6Sjeremylt 
766d7b241e6Sjeremylt static int CeedQFunctionFortranStub(void *ctx, int nq,
7678795c945Sjeremylt                                     const CeedScalar *const *u,
7688795c945Sjeremylt                                     CeedScalar *const *v) {
769777ff853SJeremy L Thompson   CeedFortranContext fctx = ctx;
770777ff853SJeremy L Thompson   CeedQFunctionContext innerctx = fctx->innerctx;
771d7b241e6Sjeremylt   int ierr;
772d7b241e6Sjeremylt 
773777ff853SJeremy L Thompson   CeedScalar *ctx_ = NULL;
774777ff853SJeremy L Thompson   // Note: Device backends are generating their own kernels from
775777ff853SJeremy L Thompson   //         single source files, so only Host backends need to
776777ff853SJeremy L Thompson   //         use this Fortran stub.
777777ff853SJeremy L Thompson   if (innerctx) {
778777ff853SJeremy L Thompson     ierr = CeedQFunctionContextGetData(innerctx, CEED_MEM_HOST, &ctx_);
779777ff853SJeremy L Thompson     CeedChk(ierr);
780777ff853SJeremy L Thompson   }
781777ff853SJeremy L Thompson 
7821e35832bSjeremylt   fctx->f((void *)ctx_,&nq,u[0],u[1],u[2],u[3],u[4],u[5],u[6],
783418fb8c2Sjeremylt           u[7],u[8],u[9],u[10],u[11],u[12],u[13],u[14],u[15],
784418fb8c2Sjeremylt           v[0],v[1],v[2],v[3],v[4],v[5],v[6],v[7],v[8],v[9],
785418fb8c2Sjeremylt           v[10],v[11],v[12],v[13],v[14],v[15],&ierr);
786777ff853SJeremy L Thompson 
787777ff853SJeremy L Thompson   if (innerctx) {
788777ff853SJeremy L Thompson     ierr = CeedQFunctionContextRestoreData(innerctx, (void *)&ctx_);
789777ff853SJeremy L Thompson     CeedChk(ierr);
790777ff853SJeremy L Thompson   }
791777ff853SJeremy L Thompson 
792d7b241e6Sjeremylt   return ierr;
793d7b241e6Sjeremylt }
794d7b241e6Sjeremylt 
795d7b241e6Sjeremylt #define fCeedQFunctionCreateInterior \
796d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctioncreateinterior, CEEDQFUNCTIONCREATEINTERIOR)
797d1d35e2fSjeremylt void fCeedQFunctionCreateInterior(int *ceed, int *vec_length,
798d7b241e6Sjeremylt                                   void (*f)(void *ctx, int *nq,
799418fb8c2Sjeremylt                                       const CeedScalar *u,const CeedScalar *u1,
800418fb8c2Sjeremylt                                       const CeedScalar *u2,const CeedScalar *u3,
801418fb8c2Sjeremylt                                       const CeedScalar *u4,const CeedScalar *u5,
802418fb8c2Sjeremylt                                       const CeedScalar *u6,const CeedScalar *u7,
803418fb8c2Sjeremylt                                       const CeedScalar *u8,const CeedScalar *u9,
804418fb8c2Sjeremylt                                       const CeedScalar *u10,const CeedScalar *u11,
805418fb8c2Sjeremylt                                       const CeedScalar *u12,const CeedScalar *u13,
806418fb8c2Sjeremylt                                       const CeedScalar *u14,const CeedScalar *u15,
807418fb8c2Sjeremylt                                       CeedScalar *v,CeedScalar *v1,CeedScalar *v2,
8088795c945Sjeremylt                                       CeedScalar *v3,CeedScalar *v4,
8098795c945Sjeremylt                                       CeedScalar *v5,CeedScalar *v6,
8108795c945Sjeremylt                                       CeedScalar *v7,CeedScalar *v8,
8118795c945Sjeremylt                                       CeedScalar *v9,CeedScalar *v10,
8128795c945Sjeremylt                                       CeedScalar *v11,CeedScalar *v12,
8138795c945Sjeremylt                                       CeedScalar *v13,CeedScalar *v14,
814418fb8c2Sjeremylt                                       CeedScalar *v15,int *err),
815288c0443SJeremy L Thompson                                   const char *source, int *qf, int *err,
816288c0443SJeremy L Thompson                                   fortran_charlen_t source_len) {
817288c0443SJeremy L Thompson   FIX_STRING(source);
818d7b241e6Sjeremylt   if (CeedQFunction_count == CeedQFunction_count_max) {
819d7b241e6Sjeremylt     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
820d7b241e6Sjeremylt     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
821d7b241e6Sjeremylt   }
822d7b241e6Sjeremylt 
823d7b241e6Sjeremylt   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
824d1d35e2fSjeremylt   *err = CeedQFunctionCreateInterior(Ceed_dict[*ceed], *vec_length,
825288c0443SJeremy L Thompson                                      CeedQFunctionFortranStub, source_c, qf_);
826d7b241e6Sjeremylt 
827d7b241e6Sjeremylt   if (*err == 0) {
828d7b241e6Sjeremylt     *qf = CeedQFunction_count++;
829d7b241e6Sjeremylt     CeedQFunction_n++;
830d7b241e6Sjeremylt   }
831d7b241e6Sjeremylt 
832777ff853SJeremy L Thompson   CeedFortranContext fctxdata;
833777ff853SJeremy L Thompson   *err = CeedCalloc(1, &fctxdata);
834d7b241e6Sjeremylt   if (*err) return;
835777ff853SJeremy L Thompson   fctxdata->f = f; fctxdata->innerctx = NULL;
836777ff853SJeremy L Thompson   CeedQFunctionContext fctx;
837777ff853SJeremy L Thompson   *err = CeedQFunctionContextCreate(Ceed_dict[*ceed], &fctx);
838777ff853SJeremy L Thompson   if (*err) return;
839777ff853SJeremy L Thompson   *err = CeedQFunctionContextSetData(fctx, CEED_MEM_HOST, CEED_OWN_POINTER,
840777ff853SJeremy L Thompson                                      sizeof(*fctxdata), fctxdata);
841777ff853SJeremy L Thompson   if (*err) return;
842777ff853SJeremy L Thompson   *err = CeedQFunctionSetContext(*qf_, fctx);
843777ff853SJeremy L Thompson   if (*err) return;
844777ff853SJeremy L Thompson   CeedQFunctionContextDestroy(&fctx);
845777ff853SJeremy L Thompson   if (*err) return;
846d7b241e6Sjeremylt 
847777ff853SJeremy L Thompson   *err = CeedQFunctionSetFortranStatus(*qf_, true);
848d7b241e6Sjeremylt }
849d7b241e6Sjeremylt 
850288c0443SJeremy L Thompson #define fCeedQFunctionCreateInteriorByName \
851288c0443SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncreateinteriorbyname, CEEDQFUNCTIONCREATEINTERIORBYNAME)
852288c0443SJeremy L Thompson void fCeedQFunctionCreateInteriorByName(int *ceed, const char *name, int *qf,
853288c0443SJeremy L Thompson                                         int *err, fortran_charlen_t name_len) {
854288c0443SJeremy L Thompson   FIX_STRING(name);
855288c0443SJeremy L Thompson   if (CeedQFunction_count == CeedQFunction_count_max) {
856288c0443SJeremy L Thompson     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
857288c0443SJeremy L Thompson     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
858288c0443SJeremy L Thompson   }
859288c0443SJeremy L Thompson 
860288c0443SJeremy L Thompson   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
861288c0443SJeremy L Thompson   *err = CeedQFunctionCreateInteriorByName(Ceed_dict[*ceed], name_c, qf_);
862288c0443SJeremy L Thompson 
863288c0443SJeremy L Thompson   if (*err == 0) {
864288c0443SJeremy L Thompson     *qf = CeedQFunction_count++;
865288c0443SJeremy L Thompson     CeedQFunction_n++;
866288c0443SJeremy L Thompson   }
867288c0443SJeremy L Thompson }
868288c0443SJeremy L Thompson 
8690219ea01SJeremy L Thompson #define fCeedQFunctionCreateIdentity \
8700219ea01SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncreateidentity, CEEDQFUNCTIONCREATEIDENTITY)
87160f77c51Sjeremylt void fCeedQFunctionCreateIdentity(int *ceed, int *size, int *inmode,
87260f77c51Sjeremylt                                   int *outmode, int *qf, int *err) {
8730219ea01SJeremy L Thompson   if (CeedQFunction_count == CeedQFunction_count_max) {
8740219ea01SJeremy L Thompson     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
8750219ea01SJeremy L Thompson     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
8760219ea01SJeremy L Thompson   }
8770219ea01SJeremy L Thompson 
8780219ea01SJeremy L Thompson   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
879399bb197SJed Brown   *err = CeedQFunctionCreateIdentity(Ceed_dict[*ceed], *size,
880399bb197SJed Brown                                      (CeedEvalMode)*inmode,
881399bb197SJed Brown                                      (CeedEvalMode)*outmode, qf_);
8820219ea01SJeremy L Thompson 
8830219ea01SJeremy L Thompson   if (*err == 0) {
8840219ea01SJeremy L Thompson     *qf = CeedQFunction_count++;
8850219ea01SJeremy L Thompson     CeedQFunction_n++;
8860219ea01SJeremy L Thompson   }
8870219ea01SJeremy L Thompson }
8880219ea01SJeremy L Thompson 
889d7b241e6Sjeremylt #define fCeedQFunctionAddInput \
890d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionaddinput,CEEDQFUNCTIONADDINPUT)
891d1d35e2fSjeremylt void fCeedQFunctionAddInput(int *qf, const char *field_name,
892d1d35e2fSjeremylt                             CeedInt *num_comp, CeedEvalMode *eval_mode, int *err,
893d1d35e2fSjeremylt                             fortran_charlen_t field_name_len) {
894d1d35e2fSjeremylt   FIX_STRING(field_name);
895d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
896d7b241e6Sjeremylt 
897d1d35e2fSjeremylt   *err = CeedQFunctionAddInput(qf_, field_name_c, *num_comp, *eval_mode);
898d7b241e6Sjeremylt }
899d7b241e6Sjeremylt 
900d7b241e6Sjeremylt #define fCeedQFunctionAddOutput \
901d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionaddoutput,CEEDQFUNCTIONADDOUTPUT)
902d1d35e2fSjeremylt void fCeedQFunctionAddOutput(int *qf, const char *field_name,
903d1d35e2fSjeremylt                              CeedInt *num_comp, CeedEvalMode *eval_mode, int *err,
904d1d35e2fSjeremylt                              fortran_charlen_t field_name_len) {
905d1d35e2fSjeremylt   FIX_STRING(field_name);
906d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
907d7b241e6Sjeremylt 
908d1d35e2fSjeremylt   *err = CeedQFunctionAddOutput(qf_, field_name_c, *num_comp, *eval_mode);
909d7b241e6Sjeremylt }
910d7b241e6Sjeremylt 
911418fb8c2Sjeremylt #define fCeedQFunctionSetContext \
912418fb8c2Sjeremylt     FORTRAN_NAME(ceedqfunctionsetcontext,CEEDQFUNCTIONSETCONTEXT)
913777ff853SJeremy L Thompson void fCeedQFunctionSetContext(int *qf, int *ctx, int *err) {
914418fb8c2Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
915777ff853SJeremy L Thompson   CeedQFunctionContext ctx_ = CeedQFunctionContext_dict[*ctx];
916418fb8c2Sjeremylt 
917777ff853SJeremy L Thompson   CeedQFunctionContext fctx;
918777ff853SJeremy L Thompson   *err = CeedQFunctionGetContext(qf_, &fctx);
919777ff853SJeremy L Thompson   if (*err) return;
920777ff853SJeremy L Thompson   CeedFortranContext fctxdata;
921777ff853SJeremy L Thompson   *err = CeedQFunctionContextGetData(fctx, CEED_MEM_HOST, &fctxdata);
922777ff853SJeremy L Thompson   if (*err) return;
923777ff853SJeremy L Thompson   fctxdata->innerctx = ctx_;
924777ff853SJeremy L Thompson   *err = CeedQFunctionContextRestoreData(fctx, (void **)&fctxdata);
925418fb8c2Sjeremylt }
926418fb8c2Sjeremylt 
92775affc3bSjeremylt #define fCeedQFunctionView \
92875affc3bSjeremylt     FORTRAN_NAME(ceedqfunctionview,CEEDQFUNCTIONVIEW)
92975affc3bSjeremylt void fCeedQFunctionView(int *qf, int *err) {
93075affc3bSjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
93175affc3bSjeremylt 
93275affc3bSjeremylt   *err = CeedQFunctionView(qf_, stdout);
93375affc3bSjeremylt }
93475affc3bSjeremylt 
935d7b241e6Sjeremylt #define fCeedQFunctionApply \
936d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionapply,CEEDQFUNCTIONAPPLY)
937d7b241e6Sjeremylt //TODO Need Fixing, double pointer
938d7b241e6Sjeremylt void fCeedQFunctionApply(int *qf, int *Q,
939aedaa0e5Sjeremylt                          int *u, int *u1, int *u2, int *u3,
940aedaa0e5Sjeremylt                          int *u4, int *u5, int *u6, int *u7,
941aedaa0e5Sjeremylt                          int *u8, int *u9, int *u10, int *u11,
942aedaa0e5Sjeremylt                          int *u12, int *u13, int *u14, int *u15,
943aedaa0e5Sjeremylt                          int *v, int *v1, int *v2, int *v3,
944aedaa0e5Sjeremylt                          int *v4, int *v5, int *v6, int *v7,
945aedaa0e5Sjeremylt                          int *v8, int *v9, int *v10, int *v11,
946aedaa0e5Sjeremylt                          int *v12, int *v13, int *v14, int *v15, int *err) {
947d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
948aedaa0e5Sjeremylt   CeedVector *in;
949bf4cb664SJeremy L Thompson   *err = CeedCalloc(CEED_FIELD_MAX, &in);
950d7b241e6Sjeremylt   if (*err) return;
951aedaa0e5Sjeremylt   in[0] = *u==FORTRAN_NULL?NULL:CeedVector_dict[*u];
952aedaa0e5Sjeremylt   in[1] = *u1==FORTRAN_NULL?NULL:CeedVector_dict[*u1];
953aedaa0e5Sjeremylt   in[2] = *u2==FORTRAN_NULL?NULL:CeedVector_dict[*u2];
954aedaa0e5Sjeremylt   in[3] = *u3==FORTRAN_NULL?NULL:CeedVector_dict[*u3];
955aedaa0e5Sjeremylt   in[4] = *u4==FORTRAN_NULL?NULL:CeedVector_dict[*u4];
956aedaa0e5Sjeremylt   in[5] = *u5==FORTRAN_NULL?NULL:CeedVector_dict[*u5];
957aedaa0e5Sjeremylt   in[6] = *u6==FORTRAN_NULL?NULL:CeedVector_dict[*u6];
958aedaa0e5Sjeremylt   in[7] = *u7==FORTRAN_NULL?NULL:CeedVector_dict[*u7];
959aedaa0e5Sjeremylt   in[8] = *u8==FORTRAN_NULL?NULL:CeedVector_dict[*u8];
960aedaa0e5Sjeremylt   in[9] = *u9==FORTRAN_NULL?NULL:CeedVector_dict[*u9];
961aedaa0e5Sjeremylt   in[10] = *u10==FORTRAN_NULL?NULL:CeedVector_dict[*u10];
962aedaa0e5Sjeremylt   in[11] = *u11==FORTRAN_NULL?NULL:CeedVector_dict[*u11];
963aedaa0e5Sjeremylt   in[12] = *u12==FORTRAN_NULL?NULL:CeedVector_dict[*u12];
964aedaa0e5Sjeremylt   in[13] = *u13==FORTRAN_NULL?NULL:CeedVector_dict[*u13];
965aedaa0e5Sjeremylt   in[14] = *u14==FORTRAN_NULL?NULL:CeedVector_dict[*u14];
966aedaa0e5Sjeremylt   in[15] = *u15==FORTRAN_NULL?NULL:CeedVector_dict[*u15];
967aedaa0e5Sjeremylt   CeedVector *out;
968bf4cb664SJeremy L Thompson   *err = CeedCalloc(CEED_FIELD_MAX, &out);
969d7b241e6Sjeremylt   if (*err) return;
970aedaa0e5Sjeremylt   out[0] = *v==FORTRAN_NULL?NULL:CeedVector_dict[*v];
971aedaa0e5Sjeremylt   out[1] = *v1==FORTRAN_NULL?NULL:CeedVector_dict[*v1];
972aedaa0e5Sjeremylt   out[2] = *v2==FORTRAN_NULL?NULL:CeedVector_dict[*v2];
973aedaa0e5Sjeremylt   out[3] = *v3==FORTRAN_NULL?NULL:CeedVector_dict[*v3];
974aedaa0e5Sjeremylt   out[4] = *v4==FORTRAN_NULL?NULL:CeedVector_dict[*v4];
975aedaa0e5Sjeremylt   out[5] = *v5==FORTRAN_NULL?NULL:CeedVector_dict[*v5];
976aedaa0e5Sjeremylt   out[6] = *v6==FORTRAN_NULL?NULL:CeedVector_dict[*v6];
977aedaa0e5Sjeremylt   out[7] = *v7==FORTRAN_NULL?NULL:CeedVector_dict[*v7];
978aedaa0e5Sjeremylt   out[8] = *v8==FORTRAN_NULL?NULL:CeedVector_dict[*v8];
979aedaa0e5Sjeremylt   out[9] = *v9==FORTRAN_NULL?NULL:CeedVector_dict[*v9];
980aedaa0e5Sjeremylt   out[10] = *v10==FORTRAN_NULL?NULL:CeedVector_dict[*v10];
981aedaa0e5Sjeremylt   out[11] = *v11==FORTRAN_NULL?NULL:CeedVector_dict[*v11];
982aedaa0e5Sjeremylt   out[12] = *v12==FORTRAN_NULL?NULL:CeedVector_dict[*v12];
983aedaa0e5Sjeremylt   out[13] = *v13==FORTRAN_NULL?NULL:CeedVector_dict[*v13];
984aedaa0e5Sjeremylt   out[14] = *v14==FORTRAN_NULL?NULL:CeedVector_dict[*v14];
985aedaa0e5Sjeremylt   out[15] = *v15==FORTRAN_NULL?NULL:CeedVector_dict[*v15];
986aedaa0e5Sjeremylt   *err = CeedQFunctionApply(qf_, *Q, in, out);
987d7b241e6Sjeremylt   if (*err) return;
988d7b241e6Sjeremylt 
989d7b241e6Sjeremylt   *err = CeedFree(&in);
990d7b241e6Sjeremylt   if (*err) return;
991d7b241e6Sjeremylt   *err = CeedFree(&out);
992d7b241e6Sjeremylt }
993d7b241e6Sjeremylt 
994d7b241e6Sjeremylt #define fCeedQFunctionDestroy \
995d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctiondestroy,CEEDQFUNCTIONDESTROY)
996d7b241e6Sjeremylt void fCeedQFunctionDestroy(int *qf, int *err) {
997b22696a8SJeremy L Thompson   if (*qf == FORTRAN_NULL) return;
998c4b814baSjeremylt 
999c4b814baSjeremylt   *err = CeedQFunctionDestroy(&CeedQFunction_dict[*qf]);
100016595307SJeremy L Thompson   if (*err == 0) {
100116595307SJeremy L Thompson     *qf = FORTRAN_NULL;
1002d7b241e6Sjeremylt     CeedQFunction_n--;
1003d7b241e6Sjeremylt     if (CeedQFunction_n == 0) {
1004d7b241e6Sjeremylt       *err = CeedFree(&CeedQFunction_dict);
1005d7b241e6Sjeremylt       CeedQFunction_count = 0;
1006d7b241e6Sjeremylt       CeedQFunction_count_max = 0;
1007d7b241e6Sjeremylt     }
1008d7b241e6Sjeremylt   }
100916595307SJeremy L Thompson }
1010d7b241e6Sjeremylt 
1011b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
1012b00b43a6SJeremy L Thompson // CeedOperator
1013b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
1014d7b241e6Sjeremylt static CeedOperator *CeedOperator_dict = NULL;
1015d7b241e6Sjeremylt static int CeedOperator_count = 0;
1016d7b241e6Sjeremylt static int CeedOperator_n = 0;
1017d7b241e6Sjeremylt static int CeedOperator_count_max = 0;
1018d7b241e6Sjeremylt 
1019d7b241e6Sjeremylt #define fCeedOperatorCreate \
1020d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorcreate, CEEDOPERATORCREATE)
1021d7b241e6Sjeremylt void fCeedOperatorCreate(int *ceed,
1022d7b241e6Sjeremylt                          int *qf, int *dqf, int *dqfT, int *op, int *err) {
1023777ff853SJeremy L Thompson   if (CeedOperator_count == CeedOperator_count_max) {
1024777ff853SJeremy L Thompson     CeedOperator_count_max += CeedOperator_count_max/2 + 1;
1025777ff853SJeremy L Thompson     CeedRealloc(CeedOperator_count_max, &CeedOperator_dict);
1026777ff853SJeremy L Thompson   }
1027d7b241e6Sjeremylt 
1028d7b241e6Sjeremylt   CeedOperator *op_ = &CeedOperator_dict[CeedOperator_count];
1029d7b241e6Sjeremylt 
1030442e7f0bSjeremylt   CeedQFunction dqf_  = CEED_QFUNCTION_NONE, dqfT_ = CEED_QFUNCTION_NONE;
1031442e7f0bSjeremylt   if (*dqf  != FORTRAN_QFUNCTION_NONE) dqf_  = CeedQFunction_dict[*dqf ];
1032442e7f0bSjeremylt   if (*dqfT != FORTRAN_QFUNCTION_NONE) dqfT_ = CeedQFunction_dict[*dqfT];
1033d7b241e6Sjeremylt 
1034d7b241e6Sjeremylt   *err = CeedOperatorCreate(Ceed_dict[*ceed], CeedQFunction_dict[*qf], dqf_,
1035d7b241e6Sjeremylt                             dqfT_, op_);
1036d7b241e6Sjeremylt   if (*err) return;
1037d7b241e6Sjeremylt   *op = CeedOperator_count++;
1038d7b241e6Sjeremylt   CeedOperator_n++;
1039d7b241e6Sjeremylt }
1040d7b241e6Sjeremylt 
104152d6035fSJeremy L Thompson #define fCeedCompositeOperatorCreate \
104252d6035fSJeremy L Thompson     FORTRAN_NAME(ceedcompositeoperatorcreate, CEEDCOMPOSITEOPERATORCREATE)
104352d6035fSJeremy L Thompson void fCeedCompositeOperatorCreate(int *ceed, int *op, int *err) {
1044777ff853SJeremy L Thompson   if (CeedOperator_count == CeedOperator_count_max) {
1045777ff853SJeremy L Thompson     CeedOperator_count_max += CeedOperator_count_max/2 + 1;
1046777ff853SJeremy L Thompson     CeedRealloc(CeedOperator_count_max, &CeedOperator_dict);
1047777ff853SJeremy L Thompson   }
104852d6035fSJeremy L Thompson 
104952d6035fSJeremy L Thompson   CeedOperator *op_ = &CeedOperator_dict[CeedOperator_count];
105052d6035fSJeremy L Thompson 
105152d6035fSJeremy L Thompson   *err = CeedCompositeOperatorCreate(Ceed_dict[*ceed], op_);
105252d6035fSJeremy L Thompson   if (*err) return;
105352d6035fSJeremy L Thompson   *op = CeedOperator_count++;
105452d6035fSJeremy L Thompson   CeedOperator_n++;
105552d6035fSJeremy L Thompson }
105652d6035fSJeremy L Thompson 
1057d7b241e6Sjeremylt #define fCeedOperatorSetField \
1058d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorsetfield,CEEDOPERATORSETFIELD)
1059d1d35e2fSjeremylt void fCeedOperatorSetField(int *op, const char *field_name, int *r, int *b,
1060d1d35e2fSjeremylt                            int *v, int *err, fortran_charlen_t field_name_len) {
1061d1d35e2fSjeremylt   FIX_STRING(field_name);
1062d7b241e6Sjeremylt   CeedElemRestriction r_;
1063d7b241e6Sjeremylt   CeedBasis b_;
1064d7b241e6Sjeremylt   CeedVector v_;
1065d7b241e6Sjeremylt 
1066d7b241e6Sjeremylt   CeedOperator op_ = CeedOperator_dict[*op];
1067d7b241e6Sjeremylt 
1068d7b241e6Sjeremylt   if (*r == FORTRAN_NULL) {
1069d7b241e6Sjeremylt     r_ = NULL;
107015910d16Sjeremylt   } else if (*r == FORTRAN_ELEMRESTRICTION_NONE) {
107115910d16Sjeremylt     r_ = CEED_ELEMRESTRICTION_NONE;
1072d7b241e6Sjeremylt   } else {
1073d7b241e6Sjeremylt     r_ = CeedElemRestriction_dict[*r];
1074d7b241e6Sjeremylt   }
10754dccadb6Sjeremylt 
1076d7b241e6Sjeremylt   if (*b == FORTRAN_NULL) {
1077d7b241e6Sjeremylt     b_ = NULL;
1078783c99b3SValeria Barra   } else if (*b == FORTRAN_BASIS_COLLOCATED) {
1079783c99b3SValeria Barra     b_ = CEED_BASIS_COLLOCATED;
1080d7b241e6Sjeremylt   } else {
1081d7b241e6Sjeremylt     b_ = CeedBasis_dict[*b];
1082d7b241e6Sjeremylt   }
1083d7b241e6Sjeremylt   if (*v == FORTRAN_NULL) {
1084d7b241e6Sjeremylt     v_ = NULL;
1085d7b241e6Sjeremylt   } else if (*v == FORTRAN_VECTOR_ACTIVE) {
1086d7b241e6Sjeremylt     v_ = CEED_VECTOR_ACTIVE;
1087d7b241e6Sjeremylt   } else if (*v == FORTRAN_VECTOR_NONE) {
1088d7b241e6Sjeremylt     v_ = CEED_VECTOR_NONE;
1089d7b241e6Sjeremylt   } else {
1090d7b241e6Sjeremylt     v_ = CeedVector_dict[*v];
1091d7b241e6Sjeremylt   }
1092d7b241e6Sjeremylt 
1093d1d35e2fSjeremylt   *err = CeedOperatorSetField(op_, field_name_c, r_, b_, v_);
1094d7b241e6Sjeremylt }
1095d7b241e6Sjeremylt 
109652d6035fSJeremy L Thompson #define fCeedCompositeOperatorAddSub \
109752d6035fSJeremy L Thompson     FORTRAN_NAME(ceedcompositeoperatoraddsub, CEEDCOMPOSITEOPERATORADDSUB)
109852d6035fSJeremy L Thompson void fCeedCompositeOperatorAddSub(int *compositeop, int *subop, int *err) {
109952d6035fSJeremy L Thompson   CeedOperator compositeop_ = CeedOperator_dict[*compositeop];
110052d6035fSJeremy L Thompson   CeedOperator subop_ = CeedOperator_dict[*subop];
110152d6035fSJeremy L Thompson 
110252d6035fSJeremy L Thompson   *err = CeedCompositeOperatorAddSub(compositeop_, subop_);
110352d6035fSJeremy L Thompson   if (*err) return;
110452d6035fSJeremy L Thompson }
110552d6035fSJeremy L Thompson 
1106d99fa3c5SJeremy L Thompson #define fCeedOperatorLinearAssembleQFunction \
1107d99fa3c5SJeremy L Thompson     FORTRAN_NAME(ceedoperatorlinearassembleqfunction, CEEDOPERATORLINEARASSEMBLEQFUNCTION)
110880ac2e43SJeremy L Thompson void fCeedOperatorLinearAssembleQFunction(int *op, int *assembledvec,
11091d102b48SJeremy L Thompson     int *assembledrstr, int *rqst, int *err) {
11101d102b48SJeremy L Thompson   // Vector
11111d102b48SJeremy L Thompson   if (CeedVector_count == CeedVector_count_max) {
11121d102b48SJeremy L Thompson     CeedVector_count_max += CeedVector_count_max/2 + 1;
11131d102b48SJeremy L Thompson     CeedRealloc(CeedVector_count_max, &CeedVector_dict);
11141d102b48SJeremy L Thompson   }
11151d102b48SJeremy L Thompson   CeedVector *assembledvec_ = &CeedVector_dict[CeedVector_count];
11161d102b48SJeremy L Thompson 
11171d102b48SJeremy L Thompson   // Restriction
11181d102b48SJeremy L Thompson   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
11191d102b48SJeremy L Thompson     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
11201d102b48SJeremy L Thompson     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
11211d102b48SJeremy L Thompson   }
11221d102b48SJeremy L Thompson   CeedElemRestriction *rstr_ =
11231d102b48SJeremy L Thompson     &CeedElemRestriction_dict[CeedElemRestriction_count];
11241d102b48SJeremy L Thompson 
11251d102b48SJeremy L Thompson   int createRequest = 1;
11261d102b48SJeremy L Thompson   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
11271d102b48SJeremy L Thompson   if (*rqst == -1 || *rqst == -2) {
11281d102b48SJeremy L Thompson     createRequest = 0;
11291d102b48SJeremy L Thompson   }
11301d102b48SJeremy L Thompson 
11311d102b48SJeremy L Thompson   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
11321d102b48SJeremy L Thompson     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
11331d102b48SJeremy L Thompson     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
11341d102b48SJeremy L Thompson   }
11351d102b48SJeremy L Thompson 
11361d102b48SJeremy L Thompson   CeedRequest *rqst_;
11371d102b48SJeremy L Thompson   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
11381d102b48SJeremy L Thompson   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
11391d102b48SJeremy L Thompson   else rqst_ = &CeedRequest_dict[CeedRequest_count];
11401d102b48SJeremy L Thompson 
114180ac2e43SJeremy L Thompson   *err = CeedOperatorLinearAssembleQFunction(CeedOperator_dict[*op],
11421d102b48SJeremy L Thompson          assembledvec_, rstr_, rqst_);
11431d102b48SJeremy L Thompson   if (*err) return;
11441d102b48SJeremy L Thompson   if (createRequest) {
11451d102b48SJeremy L Thompson     *rqst = CeedRequest_count++;
11461d102b48SJeremy L Thompson     CeedRequest_n++;
11471d102b48SJeremy L Thompson   }
11481d102b48SJeremy L Thompson 
11491d102b48SJeremy L Thompson   if (*err == 0) {
11501d102b48SJeremy L Thompson     *assembledrstr = CeedElemRestriction_count++;
11511d102b48SJeremy L Thompson     CeedElemRestriction_n++;
11521d102b48SJeremy L Thompson     *assembledvec = CeedVector_count++;
11531d102b48SJeremy L Thompson     CeedVector_n++;
11541d102b48SJeremy L Thompson   }
11551d102b48SJeremy L Thompson }
11561d102b48SJeremy L Thompson 
1157d99fa3c5SJeremy L Thompson #define fCeedOperatorLinearAssembleDiagonal \
1158d99fa3c5SJeremy L Thompson     FORTRAN_NAME(ceedoperatorlinearassemblediagonal, CEEDOPERATORLINEARASSEMBLEDIAGONAL)
115980ac2e43SJeremy L Thompson void fCeedOperatorLinearAssembleDiagonal(int *op, int *assembledvec,
1160b7ec98d8SJeremy L Thompson     int *rqst, int *err) {
1161b7ec98d8SJeremy L Thompson   int createRequest = 1;
1162b7ec98d8SJeremy L Thompson   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
1163b7ec98d8SJeremy L Thompson   if (*rqst == -1 || *rqst == -2) {
1164b7ec98d8SJeremy L Thompson     createRequest = 0;
1165b7ec98d8SJeremy L Thompson   }
1166b7ec98d8SJeremy L Thompson 
1167b7ec98d8SJeremy L Thompson   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
1168b7ec98d8SJeremy L Thompson     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
1169b7ec98d8SJeremy L Thompson     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
1170b7ec98d8SJeremy L Thompson   }
1171b7ec98d8SJeremy L Thompson 
1172b7ec98d8SJeremy L Thompson   CeedRequest *rqst_;
1173b7ec98d8SJeremy L Thompson   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
1174b7ec98d8SJeremy L Thompson   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
1175b7ec98d8SJeremy L Thompson   else rqst_ = &CeedRequest_dict[CeedRequest_count];
1176b7ec98d8SJeremy L Thompson 
117780ac2e43SJeremy L Thompson   *err = CeedOperatorLinearAssembleDiagonal(CeedOperator_dict[*op],
11782bba3ffaSJeremy L Thompson          CeedVector_dict[*assembledvec], rqst_);
1179b7ec98d8SJeremy L Thompson   if (*err) return;
1180b7ec98d8SJeremy L Thompson   if (createRequest) {
1181b7ec98d8SJeremy L Thompson     *rqst = CeedRequest_count++;
1182b7ec98d8SJeremy L Thompson     CeedRequest_n++;
1183b7ec98d8SJeremy L Thompson   }
1184b7ec98d8SJeremy L Thompson }
1185b7ec98d8SJeremy L Thompson 
1186d99fa3c5SJeremy L Thompson #define fCeedOperatorMultigridLevelCreate \
1187d99fa3c5SJeremy L Thompson     FORTRAN_NAME(ceedoperatormultigridlevelcreate, CEEDOPERATORMULTIGRIDLEVELCREATE)
1188d99fa3c5SJeremy L Thompson void fCeedOperatorMultigridLevelCreate(int *opFine, int *pMultFine,
1189d99fa3c5SJeremy L Thompson                                        int *rstrCoarse, int *basisCoarse, int *opCoarse,
1190d99fa3c5SJeremy L Thompson                                        int *opProlong, int *opRestrict, int *err) {
1191d99fa3c5SJeremy L Thompson   // Operators
1192d99fa3c5SJeremy L Thompson   CeedOperator opCoarse_, opProlong_, opRestrict_;
1193d99fa3c5SJeremy L Thompson 
1194d99fa3c5SJeremy L Thompson   // C interface call
1195d99fa3c5SJeremy L Thompson   *err = CeedOperatorMultigridLevelCreate(
1196d99fa3c5SJeremy L Thompson            CeedOperator_dict[*opFine], CeedVector_dict[*pMultFine],
1197d99fa3c5SJeremy L Thompson            CeedElemRestriction_dict[*rstrCoarse],
1198d99fa3c5SJeremy L Thompson            CeedBasis_dict[*basisCoarse],
1199d99fa3c5SJeremy L Thompson            &opCoarse_, &opProlong_, &opRestrict_);
1200d99fa3c5SJeremy L Thompson 
1201d99fa3c5SJeremy L Thompson   if (*err) return;
1202d99fa3c5SJeremy L Thompson   while (CeedOperator_count + 2 >= CeedOperator_count_max) {
1203d99fa3c5SJeremy L Thompson     CeedOperator_count_max += CeedOperator_count_max/2 + 1;
1204d99fa3c5SJeremy L Thompson   }
1205d99fa3c5SJeremy L Thompson   CeedRealloc(CeedOperator_count_max, &CeedOperator_dict);
1206d99fa3c5SJeremy L Thompson   CeedOperator_dict[CeedOperator_count] = opCoarse_;
1207d99fa3c5SJeremy L Thompson   *opCoarse = CeedOperator_count++;
1208d99fa3c5SJeremy L Thompson   CeedOperator_dict[CeedOperator_count] = opProlong_;
1209d99fa3c5SJeremy L Thompson   *opProlong = CeedOperator_count++;
1210d99fa3c5SJeremy L Thompson   CeedOperator_dict[CeedOperator_count] = opRestrict_;
1211d99fa3c5SJeremy L Thompson   *opRestrict = CeedOperator_count++;
1212d99fa3c5SJeremy L Thompson   CeedOperator_n += 3;
1213d99fa3c5SJeremy L Thompson }
1214d99fa3c5SJeremy L Thompson 
1215d99fa3c5SJeremy L Thompson #define fCeedOperatorMultigridLevelCreateTensorH1 \
1216d99fa3c5SJeremy L Thompson     FORTRAN_NAME(ceedoperatormultigridlevelcreatetensorh1, CEEDOPERATORMULTIGRIDLEVELCREATETENSORH1)
1217d99fa3c5SJeremy L Thompson void fCeedOperatorMultigridLevelCreateTensorH1(int *opFine, int *pMultFine,
1218d99fa3c5SJeremy L Thompson     int *rstrCoarse, int *basisCoarse, const CeedScalar *interpCtoF,
1219d99fa3c5SJeremy L Thompson     int *opCoarse, int *opProlong, int *opRestrict, int *err) {
1220d99fa3c5SJeremy L Thompson   // Operators
1221d99fa3c5SJeremy L Thompson   CeedOperator opCoarse_, opProlong_, opRestrict_;
1222d99fa3c5SJeremy L Thompson 
1223d99fa3c5SJeremy L Thompson   // C interface call
1224d99fa3c5SJeremy L Thompson   *err = CeedOperatorMultigridLevelCreateTensorH1(
1225d99fa3c5SJeremy L Thompson            CeedOperator_dict[*opFine], CeedVector_dict[*pMultFine],
1226d99fa3c5SJeremy L Thompson            CeedElemRestriction_dict[*rstrCoarse], CeedBasis_dict[*basisCoarse],
1227d99fa3c5SJeremy L Thompson            interpCtoF, &opCoarse_, &opProlong_, &opRestrict_);
1228d99fa3c5SJeremy L Thompson 
1229d99fa3c5SJeremy L Thompson   if (*err) return;
1230d99fa3c5SJeremy L Thompson   while (CeedOperator_count + 2 >= CeedOperator_count_max) {
1231d99fa3c5SJeremy L Thompson     CeedOperator_count_max += CeedOperator_count_max/2 + 1;
1232d99fa3c5SJeremy L Thompson   }
1233d99fa3c5SJeremy L Thompson   CeedRealloc(CeedOperator_count_max, &CeedOperator_dict);
1234d99fa3c5SJeremy L Thompson   CeedOperator_dict[CeedOperator_count] = opCoarse_;
1235d99fa3c5SJeremy L Thompson   *opCoarse = CeedOperator_count++;
1236d99fa3c5SJeremy L Thompson   CeedOperator_dict[CeedOperator_count] = opProlong_;
1237d99fa3c5SJeremy L Thompson   *opProlong = CeedOperator_count++;
1238d99fa3c5SJeremy L Thompson   CeedOperator_dict[CeedOperator_count] = opRestrict_;
1239d99fa3c5SJeremy L Thompson   *opRestrict = CeedOperator_count++;
1240d99fa3c5SJeremy L Thompson   CeedOperator_n += 3;
1241d99fa3c5SJeremy L Thompson }
1242d99fa3c5SJeremy L Thompson 
1243d99fa3c5SJeremy L Thompson #define fCeedOperatorMultigridLevelCreateH1 \
1244d99fa3c5SJeremy L Thompson     FORTRAN_NAME(ceedoperatormultigridlevelcreateh1, CEEDOPERATORMULTIGRIDLEVELCREATEH1)
1245d99fa3c5SJeremy L Thompson void fCeedOperatorMultigridLevelCreateH1(int *opFine, int *pMultFine,
1246d99fa3c5SJeremy L Thompson     int *rstrCoarse, int *basisCoarse, const CeedScalar *interpCtoF,
1247d99fa3c5SJeremy L Thompson     int *opCoarse, int *opProlong, int *opRestrict, int *err) {
1248d99fa3c5SJeremy L Thompson   // Operators
1249d99fa3c5SJeremy L Thompson   CeedOperator opCoarse_, opProlong_, opRestrict_;
1250d99fa3c5SJeremy L Thompson 
1251d99fa3c5SJeremy L Thompson   // C interface call
1252d99fa3c5SJeremy L Thompson   *err = CeedOperatorMultigridLevelCreateH1(
1253d99fa3c5SJeremy L Thompson            CeedOperator_dict[*opFine], CeedVector_dict[*pMultFine],
1254d99fa3c5SJeremy L Thompson            CeedElemRestriction_dict[*rstrCoarse], CeedBasis_dict[*basisCoarse],
1255d99fa3c5SJeremy L Thompson            interpCtoF, &opCoarse_, &opProlong_, &opRestrict_);
1256d99fa3c5SJeremy L Thompson 
1257d99fa3c5SJeremy L Thompson   if (*err) return;
1258d99fa3c5SJeremy L Thompson   while (CeedOperator_count + 2 >= CeedOperator_count_max) {
1259d99fa3c5SJeremy L Thompson     CeedOperator_count_max += CeedOperator_count_max/2 + 1;
1260d99fa3c5SJeremy L Thompson   }
1261d99fa3c5SJeremy L Thompson   CeedRealloc(CeedOperator_count_max, &CeedOperator_dict);
1262d99fa3c5SJeremy L Thompson   CeedOperator_dict[CeedOperator_count] = opCoarse_;
1263d99fa3c5SJeremy L Thompson   *opCoarse = CeedOperator_count++;
1264d99fa3c5SJeremy L Thompson   CeedOperator_dict[CeedOperator_count] = opProlong_;
1265d99fa3c5SJeremy L Thompson   *opProlong = CeedOperator_count++;
1266d99fa3c5SJeremy L Thompson   CeedOperator_dict[CeedOperator_count] = opRestrict_;
1267d99fa3c5SJeremy L Thompson   *opRestrict = CeedOperator_count++;
1268d99fa3c5SJeremy L Thompson   CeedOperator_n += 3;
1269d99fa3c5SJeremy L Thompson }
1270d99fa3c5SJeremy L Thompson 
12712ebaca42Sjeremylt #define fCeedOperatorView \
12722ebaca42Sjeremylt     FORTRAN_NAME(ceedoperatorview,CEEDOPERATORVIEW)
12732ebaca42Sjeremylt void fCeedOperatorView(int *op, int *err) {
12742ebaca42Sjeremylt   CeedOperator op_ = CeedOperator_dict[*op];
12752ebaca42Sjeremylt 
12762ebaca42Sjeremylt   *err = CeedOperatorView(op_, stdout);
12772ebaca42Sjeremylt }
12782ebaca42Sjeremylt 
1279d99fa3c5SJeremy L Thompson #define fCeedOperatorCreateFDMElementInverse \
1280d99fa3c5SJeremy L Thompson     FORTRAN_NAME(ceedoperatorcreatefdmelementinverse, CEEDOPERATORCREATEFDMELEMENTINVERSE)
12813bd813ffSjeremylt void fCeedOperatorCreateFDMElementInverse(int *op, int *fdminv,
12823bd813ffSjeremylt     int *rqst, int *err) {
12833bd813ffSjeremylt   // Operator
12843bd813ffSjeremylt   if (CeedOperator_count == CeedOperator_count_max) {
12853bd813ffSjeremylt     CeedOperator_count_max += CeedOperator_count_max/2 + 1;
12863bd813ffSjeremylt     CeedRealloc(CeedOperator_count_max, &CeedOperator_dict);
12873bd813ffSjeremylt   }
12883bd813ffSjeremylt   CeedOperator *fdminv_ =
12893bd813ffSjeremylt     &CeedOperator_dict[CeedOperator_count];
12903bd813ffSjeremylt 
12913bd813ffSjeremylt   int createRequest = 1;
12923bd813ffSjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
12933bd813ffSjeremylt   if (*rqst == -1 || *rqst == -2) {
12943bd813ffSjeremylt     createRequest = 0;
12953bd813ffSjeremylt   }
12963bd813ffSjeremylt 
12973bd813ffSjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
12983bd813ffSjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
12993bd813ffSjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
13003bd813ffSjeremylt   }
13013bd813ffSjeremylt 
13023bd813ffSjeremylt   CeedRequest *rqst_;
13033bd813ffSjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
13043bd813ffSjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
13053bd813ffSjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
13063bd813ffSjeremylt 
13073bd813ffSjeremylt   *err = CeedOperatorCreateFDMElementInverse(CeedOperator_dict[*op],
13083bd813ffSjeremylt          fdminv_, rqst_);
13093bd813ffSjeremylt   if (*err) return;
13103bd813ffSjeremylt   if (createRequest) {
13113bd813ffSjeremylt     *rqst = CeedRequest_count++;
13123bd813ffSjeremylt     CeedRequest_n++;
13133bd813ffSjeremylt   }
13143bd813ffSjeremylt 
13153bd813ffSjeremylt   if (*err == 0) {
13163bd813ffSjeremylt     *fdminv = CeedOperator_count++;
13173bd813ffSjeremylt     CeedOperator_n++;
13183bd813ffSjeremylt   }
13193bd813ffSjeremylt }
13203bd813ffSjeremylt 
1321d7b241e6Sjeremylt #define fCeedOperatorApply FORTRAN_NAME(ceedoperatorapply, CEEDOPERATORAPPLY)
1322d7b241e6Sjeremylt void fCeedOperatorApply(int *op, int *ustatevec,
1323d7b241e6Sjeremylt                         int *resvec, int *rqst, int *err) {
1324e97ff134Sjeremylt   CeedVector ustatevec_ = (*ustatevec == FORTRAN_NULL) ?
1325e97ff134Sjeremylt                           NULL : (*ustatevec == FORTRAN_VECTOR_NONE ?
1326e97ff134Sjeremylt                                   CEED_VECTOR_NONE : CeedVector_dict[*ustatevec]);
1327e97ff134Sjeremylt   CeedVector resvec_ = (*resvec == FORTRAN_NULL) ?
1328e97ff134Sjeremylt                        NULL : (*resvec == FORTRAN_VECTOR_NONE ?
1329e97ff134Sjeremylt                                CEED_VECTOR_NONE : CeedVector_dict[*resvec]);
1330d7b241e6Sjeremylt 
1331d7b241e6Sjeremylt   int createRequest = 1;
1332d7b241e6Sjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
1333d7b241e6Sjeremylt   if (*rqst == -1 || *rqst == -2) {
1334d7b241e6Sjeremylt     createRequest = 0;
1335d7b241e6Sjeremylt   }
1336d7b241e6Sjeremylt 
1337d7b241e6Sjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
1338d7b241e6Sjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
1339d7b241e6Sjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
1340d7b241e6Sjeremylt   }
1341d7b241e6Sjeremylt 
1342d7b241e6Sjeremylt   CeedRequest *rqst_;
1343d7b241e6Sjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
1344d7b241e6Sjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
1345d7b241e6Sjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
1346d7b241e6Sjeremylt 
1347d7b241e6Sjeremylt   *err = CeedOperatorApply(CeedOperator_dict[*op],
134812bf2c11SJed Brown                            ustatevec_, resvec_, rqst_);
1349d7b241e6Sjeremylt   if (*err) return;
1350d7b241e6Sjeremylt   if (createRequest) {
1351d7b241e6Sjeremylt     *rqst = CeedRequest_count++;
1352d7b241e6Sjeremylt     CeedRequest_n++;
1353d7b241e6Sjeremylt   }
1354d7b241e6Sjeremylt }
1355d7b241e6Sjeremylt 
1356cae8b89aSjeremylt #define fCeedOperatorApplyAdd FORTRAN_NAME(ceedoperatorapplyadd, CEEDOPERATORAPPLYADD)
1357cae8b89aSjeremylt void fCeedOperatorApplyAdd(int *op, int *ustatevec,
1358cae8b89aSjeremylt                            int *resvec, int *rqst, int *err) {
1359cae8b89aSjeremylt   CeedVector ustatevec_ = *ustatevec == FORTRAN_NULL
1360cae8b89aSjeremylt                           ? NULL : CeedVector_dict[*ustatevec];
1361cae8b89aSjeremylt   CeedVector resvec_ = *resvec == FORTRAN_NULL
1362cae8b89aSjeremylt                        ? NULL : CeedVector_dict[*resvec];
1363cae8b89aSjeremylt 
1364cae8b89aSjeremylt   int createRequest = 1;
1365cae8b89aSjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
1366cae8b89aSjeremylt   if (*rqst == -1 || *rqst == -2) {
1367cae8b89aSjeremylt     createRequest = 0;
1368cae8b89aSjeremylt   }
1369cae8b89aSjeremylt 
1370cae8b89aSjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
1371cae8b89aSjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
1372cae8b89aSjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
1373cae8b89aSjeremylt   }
1374cae8b89aSjeremylt 
1375cae8b89aSjeremylt   CeedRequest *rqst_;
1376cae8b89aSjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
1377cae8b89aSjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
1378cae8b89aSjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
1379cae8b89aSjeremylt 
1380cae8b89aSjeremylt   *err = CeedOperatorApplyAdd(CeedOperator_dict[*op],
1381cae8b89aSjeremylt                               ustatevec_, resvec_, rqst_);
1382cae8b89aSjeremylt   if (*err) return;
1383cae8b89aSjeremylt   if (createRequest) {
1384cae8b89aSjeremylt     *rqst = CeedRequest_count++;
1385cae8b89aSjeremylt     CeedRequest_n++;
1386cae8b89aSjeremylt   }
1387cae8b89aSjeremylt }
1388cae8b89aSjeremylt 
1389d7b241e6Sjeremylt #define fCeedOperatorApplyJacobian \
1390d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorapplyjacobian, CEEDOPERATORAPPLYJACOBIAN)
1391d7b241e6Sjeremylt void fCeedOperatorApplyJacobian(int *op, int *qdatavec, int *ustatevec,
13928795c945Sjeremylt                                 int *dustatevec, int *dresvec, int *rqst,
13938795c945Sjeremylt                                 int *err) {
1394d7b241e6Sjeremylt // TODO Uncomment this when CeedOperatorApplyJacobian is implemented
1395d7b241e6Sjeremylt //  *err = CeedOperatorApplyJacobian(CeedOperator_dict[*op], CeedVector_dict[*qdatavec],
1396d7b241e6Sjeremylt //             CeedVector_dict[*ustatevec], CeedVector_dict[*dustatevec],
1397d7b241e6Sjeremylt //             CeedVector_dict[*dresvec], &CeedRequest_dict[*rqst]);
1398d7b241e6Sjeremylt }
1399d7b241e6Sjeremylt 
1400d7b241e6Sjeremylt #define fCeedOperatorDestroy \
1401d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatordestroy, CEEDOPERATORDESTROY)
1402d7b241e6Sjeremylt void fCeedOperatorDestroy(int *op, int *err) {
1403b22696a8SJeremy L Thompson   if (*op == FORTRAN_NULL) return;
1404d7b241e6Sjeremylt   *err = CeedOperatorDestroy(&CeedOperator_dict[*op]);
140516595307SJeremy L Thompson   if (*err == 0) {
140616595307SJeremy L Thompson     *op = FORTRAN_NULL;
1407d7b241e6Sjeremylt     CeedOperator_n--;
1408d7b241e6Sjeremylt     if (CeedOperator_n == 0) {
1409d7b241e6Sjeremylt       *err = CeedFree(&CeedOperator_dict);
1410d7b241e6Sjeremylt       CeedOperator_count = 0;
1411d7b241e6Sjeremylt       CeedOperator_count_max = 0;
1412d7b241e6Sjeremylt     }
1413d7b241e6Sjeremylt   }
141416595307SJeremy L Thompson }
1415b00b43a6SJeremy L Thompson 
1416b00b43a6SJeremy L Thompson // -----------------------------------------------------------------------------
1417