xref: /libCEED/interface/ceed-fortran.c (revision 399bb19786f5baf15eebdc11a6ea2b8981cf3d61)
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
18d7b241e6Sjeremylt #include <ceed.h>
19d7b241e6Sjeremylt #include <ceed-impl.h>
20d863ab9bSjeremylt #include <ceed-backend.h>
21d7b241e6Sjeremylt #include <ceed-fortran-name.h>
22d7b241e6Sjeremylt #include <stdlib.h>
23d7b241e6Sjeremylt #include <string.h>
24d7b241e6Sjeremylt 
25d7b241e6Sjeremylt #define FORTRAN_REQUEST_IMMEDIATE -1
26d7b241e6Sjeremylt #define FORTRAN_REQUEST_ORDERED -2
27d7b241e6Sjeremylt #define FORTRAN_NULL -3
2815910d16Sjeremylt #define FORTRAN_STRIDES_BACKEND -4
2915910d16Sjeremylt #define FORTRAN_VECTOR_ACTIVE -5
3015910d16Sjeremylt #define FORTRAN_VECTOR_NONE -6
3115910d16Sjeremylt #define FORTRAN_ELEMRESTRICTION_NONE -7
3215910d16Sjeremylt #define FORTRAN_BASIS_COLLOCATED -8
3315910d16Sjeremylt #define FORTRAN_QFUNCTION_NONE -9
34d7b241e6Sjeremylt 
35d7b241e6Sjeremylt static Ceed *Ceed_dict = NULL;
36d7b241e6Sjeremylt static int Ceed_count = 0;
37d7b241e6Sjeremylt static int Ceed_n = 0;
38d7b241e6Sjeremylt static int Ceed_count_max = 0;
39d7b241e6Sjeremylt 
40c2ae719dSJed Brown // This test should actually be for the gfortran version, but we don't currently
41c2ae719dSJed Brown // have a configure system to determine that (TODO).  At present, this will use
42c2ae719dSJed Brown // the smaller integer when run with clang+gfortran=8, for example.  (That is
43c2ae719dSJed Brown // sketchy, but will likely work for users that don't have huge character
44c2ae719dSJed Brown // strings.)
45c2ae719dSJed Brown #if __GNUC__ >= 8
46c2ae719dSJed Brown typedef size_t fortran_charlen_t;
47c2ae719dSJed Brown #else
48c2ae719dSJed Brown typedef int fortran_charlen_t;
49c2ae719dSJed Brown #endif
50c2ae719dSJed Brown 
51c2ae719dSJed Brown #define Splice(a, b) a ## b
52c2ae719dSJed Brown 
53c2ae719dSJed Brown // Fortran strings are generally unterminated and the length is passed as an
54c2ae719dSJed Brown // extra argument after all the normal arguments.  Some compilers (I only know
55c2ae719dSJed Brown // of Windows) place the length argument immediately after the string parameter
56c2ae719dSJed Brown // (TODO).
57c2ae719dSJed Brown //
58c2ae719dSJed Brown // We can't just NULL-terminate the string in-place because that could overwrite
59c2ae719dSJed Brown // other strings or attempt to write to read-only memory.  This macro allocates
60c2ae719dSJed Brown // a string to hold the null-terminated version of the string that C expects.
61c2ae719dSJed Brown #define FIX_STRING(stringname)                                          \
62c2ae719dSJed Brown   char Splice(stringname, _c)[1024];                                    \
63c2ae719dSJed Brown   if (Splice(stringname, _len) > 1023)                                  \
64c2ae719dSJed Brown     CeedError(NULL, 1, "Fortran string length too long %zd", (size_t)Splice(stringname, _len)); \
65c2ae719dSJed Brown   strncpy(Splice(stringname, _c), stringname, Splice(stringname, _len)); \
66c2ae719dSJed Brown   Splice(stringname, _c)[Splice(stringname, _len)] = 0;                 \
67c2ae719dSJed Brown 
68d7b241e6Sjeremylt #define fCeedInit FORTRAN_NAME(ceedinit,CEEDINIT)
69c2ae719dSJed Brown void fCeedInit(const char *resource, int *ceed, int *err,
70c2ae719dSJed Brown                fortran_charlen_t resource_len) {
71c2ae719dSJed Brown   FIX_STRING(resource);
72d7b241e6Sjeremylt   if (Ceed_count == Ceed_count_max) {
73d7b241e6Sjeremylt     Ceed_count_max += Ceed_count_max/2 + 1;
74d7b241e6Sjeremylt     CeedRealloc(Ceed_count_max, &Ceed_dict);
75d7b241e6Sjeremylt   }
76d7b241e6Sjeremylt 
77d7b241e6Sjeremylt   Ceed *ceed_ = &Ceed_dict[Ceed_count];
78c2ae719dSJed Brown   *err = CeedInit(resource_c, ceed_);
79d7b241e6Sjeremylt 
80d7b241e6Sjeremylt   if (*err == 0) {
81d7b241e6Sjeremylt     *ceed = Ceed_count++;
82d7b241e6Sjeremylt     Ceed_n++;
83d7b241e6Sjeremylt   }
84d7b241e6Sjeremylt }
85d7b241e6Sjeremylt 
86c907536fSjeremylt #define fCeedGetPreferredMemType \
87c907536fSjeremylt     FORTRAN_NAME(ceedgetpreferredmemtype,CEEDGETPREFERREDMEMTYPE)
88c907536fSjeremylt void fCeedGetPreferredMemType(int *ceed, int *type, int *err) {
89c907536fSjeremylt   *err = CeedGetPreferredMemType(Ceed_dict[*ceed], (CeedMemType *)type);
90c907536fSjeremylt }
91c907536fSjeremylt 
920a0da059Sjeremylt #define fCeedView FORTRAN_NAME(ceedview,CEEDVIEW)
930a0da059Sjeremylt void fCeedView(int *ceed, int *err) {
940a0da059Sjeremylt   *err = CeedView(Ceed_dict[*ceed], stdout);
950a0da059Sjeremylt }
960a0da059Sjeremylt 
97d7b241e6Sjeremylt #define fCeedDestroy FORTRAN_NAME(ceeddestroy,CEEDDESTROY)
98d7b241e6Sjeremylt void fCeedDestroy(int *ceed, int *err) {
99d7b241e6Sjeremylt   *err = CeedDestroy(&Ceed_dict[*ceed]);
100d7b241e6Sjeremylt 
101d7b241e6Sjeremylt   if (*err == 0) {
102d7b241e6Sjeremylt     Ceed_n--;
103d7b241e6Sjeremylt     if (Ceed_n == 0) {
104d7b241e6Sjeremylt       CeedFree(&Ceed_dict);
105d7b241e6Sjeremylt       Ceed_count = 0;
106d7b241e6Sjeremylt       Ceed_count_max = 0;
107d7b241e6Sjeremylt     }
108d7b241e6Sjeremylt   }
109d7b241e6Sjeremylt }
110d7b241e6Sjeremylt 
111d7b241e6Sjeremylt static CeedVector *CeedVector_dict = NULL;
112d7b241e6Sjeremylt static int CeedVector_count = 0;
113d7b241e6Sjeremylt static int CeedVector_n = 0;
114d7b241e6Sjeremylt static int CeedVector_count_max = 0;
115d7b241e6Sjeremylt 
116d7b241e6Sjeremylt #define fCeedVectorCreate FORTRAN_NAME(ceedvectorcreate,CEEDVECTORCREATE)
117d7b241e6Sjeremylt void fCeedVectorCreate(int *ceed, int *length, int *vec, int *err) {
118d7b241e6Sjeremylt   if (CeedVector_count == CeedVector_count_max) {
119d7b241e6Sjeremylt     CeedVector_count_max += CeedVector_count_max/2 + 1;
120d7b241e6Sjeremylt     CeedRealloc(CeedVector_count_max, &CeedVector_dict);
121d7b241e6Sjeremylt   }
122d7b241e6Sjeremylt 
123d7b241e6Sjeremylt   CeedVector *vec_ = &CeedVector_dict[CeedVector_count];
124d7b241e6Sjeremylt   *err = CeedVectorCreate(Ceed_dict[*ceed], *length, vec_);
125d7b241e6Sjeremylt 
126d7b241e6Sjeremylt   if (*err == 0) {
127d7b241e6Sjeremylt     *vec = CeedVector_count++;
128d7b241e6Sjeremylt     CeedVector_n++;
129d7b241e6Sjeremylt   }
130d7b241e6Sjeremylt }
131d7b241e6Sjeremylt 
132d7b241e6Sjeremylt #define fCeedVectorSetArray FORTRAN_NAME(ceedvectorsetarray,CEEDVECTORSETARRAY)
133d7b241e6Sjeremylt void fCeedVectorSetArray(int *vec, int *memtype, int *copymode,
134c8b9fe72Sjeremylt                          CeedScalar *array, int64_t *offset, int *err) {
135*399bb197SJed Brown   *err = CeedVectorSetArray(CeedVector_dict[*vec], (CeedMemType)*memtype,
136*399bb197SJed Brown                             (CeedCopyMode)*copymode,
137c8b9fe72Sjeremylt                             (CeedScalar *)(array + *offset));
138d7b241e6Sjeremylt }
139d7b241e6Sjeremylt 
14054540941SJeremy L Thompson #define fCeedVectorSyncArray FORTRAN_NAME(ceedvectorsyncarray,CEEDVECTORSYNCARRAY)
14154540941SJeremy L Thompson void fCeedVectorSyncArray(int *vec, int *memtype, int *err) {
142*399bb197SJed Brown   *err = CeedVectorSyncArray(CeedVector_dict[*vec], (CeedMemType)*memtype);
14354540941SJeremy L Thompson }
14454540941SJeremy L Thompson 
145d7b241e6Sjeremylt #define fCeedVectorSetValue FORTRAN_NAME(ceedvectorsetvalue,CEEDVECTORSETVALUE)
146d7b241e6Sjeremylt void fCeedVectorSetValue(int *vec, CeedScalar *value, int *err) {
147d7b241e6Sjeremylt   *err = CeedVectorSetValue(CeedVector_dict[*vec], *value);
148d7b241e6Sjeremylt }
149d7b241e6Sjeremylt 
150d7b241e6Sjeremylt #define fCeedVectorGetArray FORTRAN_NAME(ceedvectorgetarray,CEEDVECTORGETARRAY)
151a8de75f0Sjeremylt void fCeedVectorGetArray(int *vec, int *memtype, CeedScalar *array,
152a8de75f0Sjeremylt                          int64_t *offset,
153cbfd6a90SThilina Rathnayake                          int *err) {
154d7b241e6Sjeremylt   CeedScalar *b;
155d7b241e6Sjeremylt   CeedVector vec_ = CeedVector_dict[*vec];
156*399bb197SJed Brown   *err = CeedVectorGetArray(vec_, (CeedMemType)*memtype, &b);
157cbfd6a90SThilina Rathnayake   *offset = b - array;
158d7b241e6Sjeremylt }
159d7b241e6Sjeremylt 
160d7b241e6Sjeremylt #define fCeedVectorGetArrayRead \
161d7b241e6Sjeremylt     FORTRAN_NAME(ceedvectorgetarrayread,CEEDVECTORGETARRAYREAD)
162d7b241e6Sjeremylt void fCeedVectorGetArrayRead(int *vec, int *memtype, CeedScalar *array,
1633334379fSJed Brown                              int64_t *offset, int *err) {
164d7b241e6Sjeremylt   const CeedScalar *b;
165d7b241e6Sjeremylt   CeedVector vec_ = CeedVector_dict[*vec];
166*399bb197SJed Brown   *err = CeedVectorGetArrayRead(vec_, (CeedMemType)*memtype, &b);
167cbfd6a90SThilina Rathnayake   *offset = b - array;
168d7b241e6Sjeremylt }
169d7b241e6Sjeremylt 
170d7b241e6Sjeremylt #define fCeedVectorRestoreArray \
171d7b241e6Sjeremylt     FORTRAN_NAME(ceedvectorrestorearray,CEEDVECTORRESTOREARRAY)
1726456524eSJed Brown void fCeedVectorRestoreArray(int *vec, CeedScalar *array,
1736456524eSJed Brown                              int64_t *offset, int *err) {
174d7b241e6Sjeremylt   *err = CeedVectorRestoreArray(CeedVector_dict[*vec], &array);
1756456524eSJed Brown   *offset = 0;
176d7b241e6Sjeremylt }
177d7b241e6Sjeremylt 
178d7b241e6Sjeremylt #define fCeedVectorRestoreArrayRead \
179d7b241e6Sjeremylt     FORTRAN_NAME(ceedvectorrestorearrayread,CEEDVECTORRESTOREARRAYREAD)
1806456524eSJed Brown void fCeedVectorRestoreArrayRead(int *vec, const CeedScalar *array,
1816456524eSJed Brown                                  int64_t *offset, int *err) {
182d7b241e6Sjeremylt   *err = CeedVectorRestoreArrayRead(CeedVector_dict[*vec], &array);
1836456524eSJed Brown   *offset = 0;
184d7b241e6Sjeremylt }
185d7b241e6Sjeremylt 
186547d9b97Sjeremylt #define fCeedVectorNorm \
187547d9b97Sjeremylt     FORTRAN_NAME(ceedvectornorm,CEEDVECTORNORM)
188547d9b97Sjeremylt void fCeedVectorNorm(int *vec, int *type, CeedScalar *norm, int *err) {
189*399bb197SJed Brown   *err = CeedVectorNorm(CeedVector_dict[*vec], (CeedNormType)*type, norm);
190547d9b97Sjeremylt }
191547d9b97Sjeremylt 
192d7b241e6Sjeremylt #define fCeedVectorView FORTRAN_NAME(ceedvectorview,CEEDVECTORVIEW)
193d7b241e6Sjeremylt void fCeedVectorView(int *vec, int *err) {
194d7b241e6Sjeremylt   *err = CeedVectorView(CeedVector_dict[*vec], "%12.8f", stdout);
195d7b241e6Sjeremylt }
196d7b241e6Sjeremylt 
197d7b241e6Sjeremylt #define fCeedVectorDestroy FORTRAN_NAME(ceedvectordestroy,CEEDVECTORDESTROY)
198d7b241e6Sjeremylt void fCeedVectorDestroy(int *vec, int *err) {
199d7b241e6Sjeremylt   *err = CeedVectorDestroy(&CeedVector_dict[*vec]);
200d7b241e6Sjeremylt 
201d7b241e6Sjeremylt   if (*err == 0) {
202d7b241e6Sjeremylt     CeedVector_n--;
203d7b241e6Sjeremylt     if (CeedVector_n == 0) {
204d7b241e6Sjeremylt       CeedFree(&CeedVector_dict);
205d7b241e6Sjeremylt       CeedVector_count = 0;
206d7b241e6Sjeremylt       CeedVector_count_max = 0;
207d7b241e6Sjeremylt     }
208d7b241e6Sjeremylt   }
209d7b241e6Sjeremylt }
210d7b241e6Sjeremylt 
211d7b241e6Sjeremylt static CeedElemRestriction *CeedElemRestriction_dict = NULL;
212d7b241e6Sjeremylt static int CeedElemRestriction_count = 0;
213d7b241e6Sjeremylt static int CeedElemRestriction_n = 0;
214d7b241e6Sjeremylt static int CeedElemRestriction_count_max = 0;
215d7b241e6Sjeremylt 
216d7b241e6Sjeremylt #define fCeedElemRestrictionCreate \
217d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictioncreate, CEEDELEMRESTRICTIONCREATE)
21861dbc9d2Sjeremylt void fCeedElemRestrictionCreate(int *ceed, int *imode, int *nelements,
2198795c945Sjeremylt                                 int *esize, int *nnodes, int *ncomp,
2208795c945Sjeremylt                                 int *memtype, int *copymode, const int *indices,
2218795c945Sjeremylt                                 int *elemrestriction, int *err) {
222d7b241e6Sjeremylt   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
223d7b241e6Sjeremylt     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
224d7b241e6Sjeremylt     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
225d7b241e6Sjeremylt   }
226d7b241e6Sjeremylt 
227d7b241e6Sjeremylt   const int *indices_ = indices;
228d7b241e6Sjeremylt 
229d7b241e6Sjeremylt   CeedElemRestriction *elemrestriction_ =
230d7b241e6Sjeremylt     &CeedElemRestriction_dict[CeedElemRestriction_count];
231*399bb197SJed Brown   *err = CeedElemRestrictionCreate(Ceed_dict[*ceed], (CeedInterlaceMode)*imode,
232*399bb197SJed Brown                                    *nelements, *esize, *nnodes, *ncomp, (CeedMemType)*memtype,
233*399bb197SJed Brown                                    (CeedCopyMode)*copymode, indices_, elemrestriction_);
234d7b241e6Sjeremylt 
235d7b241e6Sjeremylt   if (*err == 0) {
236d7b241e6Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
237d7b241e6Sjeremylt     CeedElemRestriction_n++;
238d7b241e6Sjeremylt   }
239d7b241e6Sjeremylt }
240d7b241e6Sjeremylt 
2417509a596Sjeremylt #define fCeedElemRestrictionCreateStrided \
2427509a596Sjeremylt     FORTRAN_NAME(ceedelemrestrictioncreatestrided, CEEDELEMRESTRICTIONCREATESTRIDED)
2437509a596Sjeremylt void fCeedElemRestrictionCreateStrided(int *ceed, int *nelements, int *esize,
2447509a596Sjeremylt                                        int *nnodes, int *ncomp, int *strides,
245d7b241e6Sjeremylt                                        int *elemrestriction, int *err) {
246d7b241e6Sjeremylt   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
247d7b241e6Sjeremylt     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
248d7b241e6Sjeremylt     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
249d7b241e6Sjeremylt   }
250d7b241e6Sjeremylt 
251d7b241e6Sjeremylt   CeedElemRestriction *elemrestriction_ =
252d7b241e6Sjeremylt     &CeedElemRestriction_dict[CeedElemRestriction_count];
2537509a596Sjeremylt   *err = CeedElemRestrictionCreateStrided(Ceed_dict[*ceed], *nelements, *esize,
254523b8ea0Sjeremylt                                           *nnodes, *ncomp,
255*399bb197SJed Brown                                           *strides == FORTRAN_STRIDES_BACKEND ? CEED_STRIDES_BACKEND : strides,
256523b8ea0Sjeremylt                                           elemrestriction_);
257d7b241e6Sjeremylt   if (*err == 0) {
258d7b241e6Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
259d7b241e6Sjeremylt     CeedElemRestriction_n++;
260d7b241e6Sjeremylt   }
261d7b241e6Sjeremylt }
262d7b241e6Sjeremylt 
263d7b241e6Sjeremylt #define fCeedElemRestrictionCreateBlocked \
264d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictioncreateblocked,CEEDELEMRESTRICTIONCREATEBLOCKED)
26561dbc9d2Sjeremylt void fCeedElemRestrictionCreateBlocked(int *ceed, int *imode, int *nelements,
2668795c945Sjeremylt                                        int *esize, int *blocksize, int *nnodes,
2678795c945Sjeremylt                                        int *ncomp, int *mtype, int *cmode,
2688795c945Sjeremylt                                        int *blkindices, int *elemrestriction,
2698795c945Sjeremylt                                        int *err) {
270d7b241e6Sjeremylt 
271d7b241e6Sjeremylt   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
272d7b241e6Sjeremylt     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
273d7b241e6Sjeremylt     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
274d7b241e6Sjeremylt   }
275d7b241e6Sjeremylt 
276d7b241e6Sjeremylt   CeedElemRestriction *elemrestriction_ =
277d7b241e6Sjeremylt     &CeedElemRestriction_dict[CeedElemRestriction_count];
278*399bb197SJed Brown   *err = CeedElemRestrictionCreateBlocked(Ceed_dict[*ceed],
279*399bb197SJed Brown                                           (CeedInterlaceMode)*imode, *nelements,
280a8d32208Sjeremylt                                           *esize, *blocksize, *nnodes, *ncomp,
281*399bb197SJed Brown                                           (CeedMemType)*mtype, (CeedCopyMode)*cmode, blkindices,
282a8d32208Sjeremylt                                           elemrestriction_);
283d7b241e6Sjeremylt 
284d7b241e6Sjeremylt   if (*err == 0) {
285d7b241e6Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
286d7b241e6Sjeremylt     CeedElemRestriction_n++;
287d7b241e6Sjeremylt   }
288d7b241e6Sjeremylt }
289d7b241e6Sjeremylt 
2907509a596Sjeremylt #define fCeedElemRestrictionCreateBlockedStrided \
2917509a596Sjeremylt     FORTRAN_NAME(ceedelemrestrictioncreateblockedstrided, CEEDELEMRESTRICTIONCREATEBLOCKEDSTRIDED)
2927509a596Sjeremylt void fCeedElemRestrictionCreateBlockedStrided(int *ceed, int *nelements,
2937509a596Sjeremylt     int *esize, int *blksize,
2947509a596Sjeremylt     int *nnodes, int *ncomp,
2957509a596Sjeremylt     int *strides,
2967509a596Sjeremylt     int *elemrestriction, int *err) {
2977509a596Sjeremylt   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
2987509a596Sjeremylt     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
2997509a596Sjeremylt     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
3007509a596Sjeremylt   }
3017509a596Sjeremylt 
3027509a596Sjeremylt   CeedElemRestriction *elemrestriction_ =
3037509a596Sjeremylt     &CeedElemRestriction_dict[CeedElemRestriction_count];
3047509a596Sjeremylt   *err = CeedElemRestrictionCreateBlockedStrided(Ceed_dict[*ceed], *nelements,
3057509a596Sjeremylt          *esize, *blksize, *nnodes, *ncomp, strides, elemrestriction_);
3067509a596Sjeremylt   if (*err == 0) {
3077509a596Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
3087509a596Sjeremylt     CeedElemRestriction_n++;
3097509a596Sjeremylt   }
3107509a596Sjeremylt }
3117509a596Sjeremylt 
312d7b241e6Sjeremylt static CeedRequest *CeedRequest_dict = NULL;
313d7b241e6Sjeremylt static int CeedRequest_count = 0;
314d7b241e6Sjeremylt static int CeedRequest_n = 0;
315d7b241e6Sjeremylt static int CeedRequest_count_max = 0;
316d7b241e6Sjeremylt 
317d7b241e6Sjeremylt #define fCeedElemRestrictionApply \
318d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictionapply,CEEDELEMRESTRICTIONAPPLY)
319a8d32208Sjeremylt void fCeedElemRestrictionApply(int *elemr, int *tmode, int *uvec, int *ruvec,
320a8d32208Sjeremylt                                int *rqst, int *err) {
321d7b241e6Sjeremylt   int createRequest = 1;
322d7b241e6Sjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
323d7b241e6Sjeremylt   if (*rqst == FORTRAN_REQUEST_IMMEDIATE || *rqst == FORTRAN_REQUEST_ORDERED)
324d7b241e6Sjeremylt     createRequest = 0;
325d7b241e6Sjeremylt 
326d7b241e6Sjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
327d7b241e6Sjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
328d7b241e6Sjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
329d7b241e6Sjeremylt   }
330d7b241e6Sjeremylt 
331d7b241e6Sjeremylt   CeedRequest *rqst_;
332d7b241e6Sjeremylt   if      (*rqst == FORTRAN_REQUEST_IMMEDIATE) rqst_ = CEED_REQUEST_IMMEDIATE;
333d7b241e6Sjeremylt   else if (*rqst == FORTRAN_REQUEST_ORDERED  ) rqst_ = CEED_REQUEST_ORDERED;
334d7b241e6Sjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
335d7b241e6Sjeremylt 
336*399bb197SJed Brown   *err = CeedElemRestrictionApply(CeedElemRestriction_dict[*elemr],
337*399bb197SJed Brown                                   (CeedTransposeMode)*tmode,
338a8d32208Sjeremylt                                   CeedVector_dict[*uvec],
3398795c945Sjeremylt                                   CeedVector_dict[*ruvec], rqst_);
340d7b241e6Sjeremylt 
341d7b241e6Sjeremylt   if (*err == 0 && createRequest) {
342d7b241e6Sjeremylt     *rqst = CeedRequest_count++;
343d7b241e6Sjeremylt     CeedRequest_n++;
344d7b241e6Sjeremylt   }
345d7b241e6Sjeremylt }
346d7b241e6Sjeremylt 
347be9261b7Sjeremylt #define fCeedElemRestrictionApplyBlock \
348be9261b7Sjeremylt     FORTRAN_NAME(ceedelemrestrictionapplyblock,CEEDELEMRESTRICTIONAPPLYBLOCK)
349f90c8643Sjeremylt void fCeedElemRestrictionApplyBlock(int *elemr, int *block, int *tmode,
350be9261b7Sjeremylt                                     int *uvec, int *ruvec, int *rqst, int *err) {
351be9261b7Sjeremylt   int createRequest = 1;
352be9261b7Sjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
353be9261b7Sjeremylt   if (*rqst == FORTRAN_REQUEST_IMMEDIATE || *rqst == FORTRAN_REQUEST_ORDERED)
354be9261b7Sjeremylt     createRequest = 0;
355be9261b7Sjeremylt 
356be9261b7Sjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
357be9261b7Sjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
358be9261b7Sjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
359be9261b7Sjeremylt   }
360be9261b7Sjeremylt 
361be9261b7Sjeremylt   CeedRequest *rqst_;
362be9261b7Sjeremylt   if      (*rqst == FORTRAN_REQUEST_IMMEDIATE) rqst_ = CEED_REQUEST_IMMEDIATE;
363be9261b7Sjeremylt   else if (*rqst == FORTRAN_REQUEST_ORDERED  ) rqst_ = CEED_REQUEST_ORDERED;
364be9261b7Sjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
365be9261b7Sjeremylt 
366be9261b7Sjeremylt   *err = CeedElemRestrictionApplyBlock(CeedElemRestriction_dict[*elemr], *block,
367*399bb197SJed Brown                                        (CeedTransposeMode)*tmode, CeedVector_dict[*uvec],
368be9261b7Sjeremylt                                        CeedVector_dict[*ruvec], rqst_);
369be9261b7Sjeremylt 
370be9261b7Sjeremylt   if (*err == 0 && createRequest) {
371be9261b7Sjeremylt     *rqst = CeedRequest_count++;
372be9261b7Sjeremylt     CeedRequest_n++;
373be9261b7Sjeremylt   }
374be9261b7Sjeremylt }
375be9261b7Sjeremylt 
3761469ee4dSjeremylt #define fCeedElemRestrictionGetMultiplicity \
3771469ee4dSjeremylt     FORTRAN_NAME(ceedelemrestrictiongetmultiplicity,CEEDELEMRESTRICTIONGETMULTIPLICITY)
378a8d32208Sjeremylt void fCeedElemRestrictionGetMultiplicity(int *elemr, int *mult, int *err) {
3791469ee4dSjeremylt   *err = CeedElemRestrictionGetMultiplicity(CeedElemRestriction_dict[*elemr],
380a8d32208Sjeremylt          CeedVector_dict[*mult]);
3811469ee4dSjeremylt }
3821469ee4dSjeremylt 
3835a86f033Sjeremylt #define fCeedElemRestrictionView \
3845a86f033Sjeremylt     FORTRAN_NAME(ceedelemrestrictionview,CEEDELEMRESTRICTIONVIEW)
3855a86f033Sjeremylt void fCeedElemRestrictionView(int *elemr, int *err) {
3865a86f033Sjeremylt   *err = CeedElemRestrictionView(CeedElemRestriction_dict[*elemr], stdout);
3875a86f033Sjeremylt }
3881469ee4dSjeremylt 
389d7b241e6Sjeremylt #define fCeedRequestWait FORTRAN_NAME(ceedrequestwait, CEEDREQUESTWAIT)
390d7b241e6Sjeremylt void fCeedRequestWait(int *rqst, int *err) {
391d7b241e6Sjeremylt   // TODO Uncomment this once CeedRequestWait is implemented
392d7b241e6Sjeremylt   //*err = CeedRequestWait(&CeedRequest_dict[*rqst]);
393d7b241e6Sjeremylt 
394d7b241e6Sjeremylt   if (*err == 0) {
395d7b241e6Sjeremylt     CeedRequest_n--;
396d7b241e6Sjeremylt     if (CeedRequest_n == 0) {
397d7b241e6Sjeremylt       CeedFree(&CeedRequest_dict);
398d7b241e6Sjeremylt       CeedRequest_count = 0;
399d7b241e6Sjeremylt       CeedRequest_count_max = 0;
400d7b241e6Sjeremylt     }
401d7b241e6Sjeremylt   }
402d7b241e6Sjeremylt }
403d7b241e6Sjeremylt 
404d7b241e6Sjeremylt #define fCeedElemRestrictionDestroy \
405d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictiondestroy,CEEDELEMRESTRICTIONDESTROY)
406d7b241e6Sjeremylt void fCeedElemRestrictionDestroy(int *elem, int *err) {
407d7b241e6Sjeremylt   *err = CeedElemRestrictionDestroy(&CeedElemRestriction_dict[*elem]);
408d7b241e6Sjeremylt 
409d7b241e6Sjeremylt   if (*err == 0) {
410d7b241e6Sjeremylt     CeedElemRestriction_n--;
411d7b241e6Sjeremylt     if (CeedElemRestriction_n == 0) {
412d7b241e6Sjeremylt       CeedFree(&CeedElemRestriction_dict);
413d7b241e6Sjeremylt       CeedElemRestriction_count = 0;
414d7b241e6Sjeremylt       CeedElemRestriction_count_max = 0;
415d7b241e6Sjeremylt     }
416d7b241e6Sjeremylt   }
417d7b241e6Sjeremylt }
418d7b241e6Sjeremylt 
419d7b241e6Sjeremylt static CeedBasis *CeedBasis_dict = NULL;
420d7b241e6Sjeremylt static int CeedBasis_count = 0;
421d7b241e6Sjeremylt static int CeedBasis_n = 0;
422d7b241e6Sjeremylt static int CeedBasis_count_max = 0;
423d7b241e6Sjeremylt 
424d7b241e6Sjeremylt #define fCeedBasisCreateTensorH1Lagrange \
425d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasiscreatetensorh1lagrange, CEEDBASISCREATETENSORH1LAGRANGE)
426d7b241e6Sjeremylt void fCeedBasisCreateTensorH1Lagrange(int *ceed, int *dim,
4278795c945Sjeremylt                                       int *ncomp, int *P, int *Q, int *quadmode,
4288795c945Sjeremylt                                       int *basis, int *err) {
429d7b241e6Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
430d7b241e6Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
431d7b241e6Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
432d7b241e6Sjeremylt   }
433d7b241e6Sjeremylt 
434a8de75f0Sjeremylt   *err = CeedBasisCreateTensorH1Lagrange(Ceed_dict[*ceed], *dim, *ncomp, *P, *Q,
435*399bb197SJed Brown                                          (CeedQuadMode)*quadmode,
4368795c945Sjeremylt                                          &CeedBasis_dict[CeedBasis_count]);
437d7b241e6Sjeremylt 
438d7b241e6Sjeremylt   if (*err == 0) {
439d7b241e6Sjeremylt     *basis = CeedBasis_count++;
440d7b241e6Sjeremylt     CeedBasis_n++;
441d7b241e6Sjeremylt   }
442d7b241e6Sjeremylt }
443d7b241e6Sjeremylt 
444d7b241e6Sjeremylt #define fCeedBasisCreateTensorH1 \
445d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasiscreatetensorh1, CEEDBASISCREATETENSORH1)
446a8de75f0Sjeremylt void fCeedBasisCreateTensorH1(int *ceed, int *dim, int *ncomp, int *P1d,
4478795c945Sjeremylt                               int *Q1d, const CeedScalar *interp1d,
4488795c945Sjeremylt                               const CeedScalar *grad1d,
4498795c945Sjeremylt                               const CeedScalar *qref1d,
4508795c945Sjeremylt                               const CeedScalar *qweight1d, int *basis,
4518795c945Sjeremylt                               int *err) {
452d7b241e6Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
453d7b241e6Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
454d7b241e6Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
455d7b241e6Sjeremylt   }
456d7b241e6Sjeremylt 
457a8de75f0Sjeremylt   *err = CeedBasisCreateTensorH1(Ceed_dict[*ceed], *dim, *ncomp, *P1d, *Q1d,
4588795c945Sjeremylt                                  interp1d, grad1d, qref1d, qweight1d,
4598795c945Sjeremylt                                  &CeedBasis_dict[CeedBasis_count]);
460d7b241e6Sjeremylt 
461d7b241e6Sjeremylt   if (*err == 0) {
462d7b241e6Sjeremylt     *basis = CeedBasis_count++;
463d7b241e6Sjeremylt     CeedBasis_n++;
464d7b241e6Sjeremylt   }
465d7b241e6Sjeremylt }
466d7b241e6Sjeremylt 
467a8de75f0Sjeremylt #define fCeedBasisCreateH1 \
468a8de75f0Sjeremylt     FORTRAN_NAME(ceedbasiscreateh1, CEEDBASISCREATEH1)
4698795c945Sjeremylt void fCeedBasisCreateH1(int *ceed, int *topo, int *ncomp, int *nnodes,
4708795c945Sjeremylt                         int *nqpts, const CeedScalar *interp,
4718795c945Sjeremylt                         const CeedScalar *grad, const CeedScalar *qref,
4728795c945Sjeremylt                         const CeedScalar *qweight, int *basis, int *err) {
473a8de75f0Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
474a8de75f0Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
475a8de75f0Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
476a8de75f0Sjeremylt   }
477a8de75f0Sjeremylt 
478*399bb197SJed Brown   *err = CeedBasisCreateH1(Ceed_dict[*ceed], (CeedElemTopology)*topo, *ncomp,
479*399bb197SJed Brown                            *nnodes, *nqpts, interp, grad, qref, qweight,
4808795c945Sjeremylt                            &CeedBasis_dict[CeedBasis_count]);
481a8de75f0Sjeremylt 
482a8de75f0Sjeremylt   if (*err == 0) {
483a8de75f0Sjeremylt     *basis = CeedBasis_count++;
484a8de75f0Sjeremylt     CeedBasis_n++;
485a8de75f0Sjeremylt   }
486a8de75f0Sjeremylt }
487a8de75f0Sjeremylt 
488d7b241e6Sjeremylt #define fCeedBasisView FORTRAN_NAME(ceedbasisview, CEEDBASISVIEW)
489d7b241e6Sjeremylt void fCeedBasisView(int *basis, int *err) {
490d7b241e6Sjeremylt   *err = CeedBasisView(CeedBasis_dict[*basis], stdout);
491d7b241e6Sjeremylt }
492d7b241e6Sjeremylt 
493d7b241e6Sjeremylt #define fCeedQRFactorization \
494d7b241e6Sjeremylt     FORTRAN_NAME(ceedqrfactorization, CEEDQRFACTORIZATION)
495a7bd39daSjeremylt void fCeedQRFactorization(int *ceed, CeedScalar *mat, CeedScalar *tau, int *m,
496a7bd39daSjeremylt                           int *n, int *err) {
497a7bd39daSjeremylt   *err = CeedQRFactorization(Ceed_dict[*ceed], mat, tau, *m, *n);
498d7b241e6Sjeremylt }
499d7b241e6Sjeremylt 
50052bfb9bbSJeremy L Thompson #define fCeedSymmetricSchurDecomposition \
50152bfb9bbSJeremy L Thompson     FORTRAN_NAME(ceedsymmetricschurdecomposition, CEEDSYMMETRICSCHURDECOMPOSITION)
50252bfb9bbSJeremy L Thompson void fCeedSymmetricSchurDecomposition(int *ceed, CeedScalar *mat,
50352bfb9bbSJeremy L Thompson                                       CeedScalar *lambda, int *n, int *err) {
50452bfb9bbSJeremy L Thompson   *err = CeedSymmetricSchurDecomposition(Ceed_dict[*ceed], mat, lambda, *n);
50552bfb9bbSJeremy L Thompson }
50652bfb9bbSJeremy L Thompson 
50752bfb9bbSJeremy L Thompson #define fCeedSimultaneousDiagonalization \
50852bfb9bbSJeremy L Thompson     FORTRAN_NAME(ceedsimultaneousdiagonalization, CEEDSIMULTANEOUSDIAGONALIZATION)
50952bfb9bbSJeremy L Thompson void fCeedSimultaneousDiagonalization(int *ceed, CeedScalar *matA,
51052bfb9bbSJeremy L Thompson                                       CeedScalar *matB, CeedScalar *x,
51152bfb9bbSJeremy L Thompson                                       CeedScalar *lambda, int *n, int *err) {
51252bfb9bbSJeremy L Thompson   *err = CeedSimultaneousDiagonalization(Ceed_dict[*ceed], matA, matB, x,
51352bfb9bbSJeremy L Thompson                                          lambda, *n);
51452bfb9bbSJeremy L Thompson }
51552bfb9bbSJeremy L Thompson 
516783c99b3SValeria Barra #define fCeedBasisGetCollocatedGrad \
517783c99b3SValeria Barra     FORTRAN_NAME(ceedbasisgetcollocatedgrad, CEEDBASISGETCOLLOCATEDGRAD)
518783c99b3SValeria Barra void fCeedBasisGetCollocatedGrad(int *basis, CeedScalar *colograd1d,
519d7b241e6Sjeremylt                                  int *err) {
520783c99b3SValeria Barra   *err = CeedBasisGetCollocatedGrad(CeedBasis_dict[*basis], colograd1d);
521d7b241e6Sjeremylt }
522d7b241e6Sjeremylt 
523d7b241e6Sjeremylt #define fCeedBasisApply FORTRAN_NAME(ceedbasisapply, CEEDBASISAPPLY)
524d7b241e6Sjeremylt void fCeedBasisApply(int *basis, int *nelem, int *tmode, int *emode,
525aedaa0e5Sjeremylt                      int *u, int *v, int *err) {
526*399bb197SJed Brown   *err = CeedBasisApply(CeedBasis_dict[*basis], *nelem, (CeedTransposeMode)*tmode,
527*399bb197SJed Brown                         (CeedEvalMode)*emode,
528*399bb197SJed Brown                         *u == FORTRAN_VECTOR_NONE ? CEED_VECTOR_NONE : CeedVector_dict[*u],
529aedaa0e5Sjeremylt                         CeedVector_dict[*v]);
530d7b241e6Sjeremylt }
531d7b241e6Sjeremylt 
532d7b241e6Sjeremylt #define fCeedBasisGetNumNodes \
533d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasisgetnumnodes, CEEDBASISGETNUMNODES)
534d7b241e6Sjeremylt void fCeedBasisGetNumNodes(int *basis, int *P, int *err) {
535d7b241e6Sjeremylt   *err = CeedBasisGetNumNodes(CeedBasis_dict[*basis], P);
536d7b241e6Sjeremylt }
537d7b241e6Sjeremylt 
538d7b241e6Sjeremylt #define fCeedBasisGetNumQuadraturePoints \
539d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasisgetnumquadraturepoints, CEEDBASISGETNUMQUADRATUREPOINTS)
540d7b241e6Sjeremylt void fCeedBasisGetNumQuadraturePoints(int *basis, int *Q, int *err) {
541d7b241e6Sjeremylt   *err = CeedBasisGetNumQuadraturePoints(CeedBasis_dict[*basis], Q);
542d7b241e6Sjeremylt }
543d7b241e6Sjeremylt 
544d7b241e6Sjeremylt #define fCeedBasisDestroy FORTRAN_NAME(ceedbasisdestroy,CEEDBASISDESTROY)
545d7b241e6Sjeremylt void fCeedBasisDestroy(int *basis, int *err) {
546d7b241e6Sjeremylt   *err = CeedBasisDestroy(&CeedBasis_dict[*basis]);
547d7b241e6Sjeremylt 
548d7b241e6Sjeremylt   if (*err == 0) {
549d7b241e6Sjeremylt     CeedBasis_n--;
550d7b241e6Sjeremylt     if (CeedBasis_n == 0) {
551d7b241e6Sjeremylt       CeedFree(&CeedBasis_dict);
552d7b241e6Sjeremylt       CeedBasis_count = 0;
553d7b241e6Sjeremylt       CeedBasis_count_max = 0;
554d7b241e6Sjeremylt     }
555d7b241e6Sjeremylt   }
556d7b241e6Sjeremylt }
557d7b241e6Sjeremylt 
558d7b241e6Sjeremylt #define fCeedGaussQuadrature FORTRAN_NAME(ceedgaussquadrature, CEEDGAUSSQUADRATURE)
559d7b241e6Sjeremylt void fCeedGaussQuadrature(int *Q, CeedScalar *qref1d, CeedScalar *qweight1d,
560d7b241e6Sjeremylt                           int *err) {
561d7b241e6Sjeremylt   *err = CeedGaussQuadrature(*Q, qref1d, qweight1d);
562d7b241e6Sjeremylt }
563d7b241e6Sjeremylt 
564d7b241e6Sjeremylt #define fCeedLobattoQuadrature \
565d7b241e6Sjeremylt     FORTRAN_NAME(ceedlobattoquadrature, CEEDLOBATTOQUADRATURE)
566d7b241e6Sjeremylt void fCeedLobattoQuadrature(int *Q, CeedScalar *qref1d, CeedScalar *qweight1d,
567d7b241e6Sjeremylt                             int *err) {
568d7b241e6Sjeremylt   *err = CeedLobattoQuadrature(*Q, qref1d, qweight1d);
569d7b241e6Sjeremylt }
570d7b241e6Sjeremylt 
571d7b241e6Sjeremylt static CeedQFunction *CeedQFunction_dict = NULL;
572d7b241e6Sjeremylt static int CeedQFunction_count = 0;
573d7b241e6Sjeremylt static int CeedQFunction_n = 0;
574d7b241e6Sjeremylt static int CeedQFunction_count_max = 0;
575d7b241e6Sjeremylt 
576d7b241e6Sjeremylt static int CeedQFunctionFortranStub(void *ctx, int nq,
5778795c945Sjeremylt                                     const CeedScalar *const *u,
5788795c945Sjeremylt                                     CeedScalar *const *v) {
579418fb8c2Sjeremylt   fContext *fctx = ctx;
580d7b241e6Sjeremylt   int ierr;
581d7b241e6Sjeremylt 
5821e35832bSjeremylt   CeedScalar *ctx_ = (CeedScalar *) fctx->innerctx;
5831e35832bSjeremylt   fctx->f((void *)ctx_,&nq,u[0],u[1],u[2],u[3],u[4],u[5],u[6],
584418fb8c2Sjeremylt           u[7],u[8],u[9],u[10],u[11],u[12],u[13],u[14],u[15],
585418fb8c2Sjeremylt           v[0],v[1],v[2],v[3],v[4],v[5],v[6],v[7],v[8],v[9],
586418fb8c2Sjeremylt           v[10],v[11],v[12],v[13],v[14],v[15],&ierr);
587d7b241e6Sjeremylt   return ierr;
588d7b241e6Sjeremylt }
589d7b241e6Sjeremylt 
590d7b241e6Sjeremylt #define fCeedQFunctionCreateInterior \
591d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctioncreateinterior, CEEDQFUNCTIONCREATEINTERIOR)
592d7b241e6Sjeremylt void fCeedQFunctionCreateInterior(int *ceed, int *vlength,
593d7b241e6Sjeremylt                                   void (*f)(void *ctx, int *nq,
594418fb8c2Sjeremylt                                       const CeedScalar *u,const CeedScalar *u1,
595418fb8c2Sjeremylt                                       const CeedScalar *u2,const CeedScalar *u3,
596418fb8c2Sjeremylt                                       const CeedScalar *u4,const CeedScalar *u5,
597418fb8c2Sjeremylt                                       const CeedScalar *u6,const CeedScalar *u7,
598418fb8c2Sjeremylt                                       const CeedScalar *u8,const CeedScalar *u9,
599418fb8c2Sjeremylt                                       const CeedScalar *u10,const CeedScalar *u11,
600418fb8c2Sjeremylt                                       const CeedScalar *u12,const CeedScalar *u13,
601418fb8c2Sjeremylt                                       const CeedScalar *u14,const CeedScalar *u15,
602418fb8c2Sjeremylt                                       CeedScalar *v,CeedScalar *v1,CeedScalar *v2,
6038795c945Sjeremylt                                       CeedScalar *v3,CeedScalar *v4,
6048795c945Sjeremylt                                       CeedScalar *v5,CeedScalar *v6,
6058795c945Sjeremylt                                       CeedScalar *v7,CeedScalar *v8,
6068795c945Sjeremylt                                       CeedScalar *v9,CeedScalar *v10,
6078795c945Sjeremylt                                       CeedScalar *v11,CeedScalar *v12,
6088795c945Sjeremylt                                       CeedScalar *v13,CeedScalar *v14,
609418fb8c2Sjeremylt                                       CeedScalar *v15,int *err),
610288c0443SJeremy L Thompson                                   const char *source, int *qf, int *err,
611288c0443SJeremy L Thompson                                   fortran_charlen_t source_len) {
612288c0443SJeremy L Thompson   FIX_STRING(source);
613d7b241e6Sjeremylt   if (CeedQFunction_count == CeedQFunction_count_max) {
614d7b241e6Sjeremylt     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
615d7b241e6Sjeremylt     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
616d7b241e6Sjeremylt   }
617d7b241e6Sjeremylt 
618d7b241e6Sjeremylt   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
619d7b241e6Sjeremylt   *err = CeedQFunctionCreateInterior(Ceed_dict[*ceed], *vlength,
620288c0443SJeremy L Thompson                                      CeedQFunctionFortranStub, source_c, qf_);
621d7b241e6Sjeremylt 
622d7b241e6Sjeremylt   if (*err == 0) {
623d7b241e6Sjeremylt     *qf = CeedQFunction_count++;
624d7b241e6Sjeremylt     CeedQFunction_n++;
625d7b241e6Sjeremylt   }
626d7b241e6Sjeremylt 
627418fb8c2Sjeremylt   fContext *fctx;
628d7b241e6Sjeremylt   *err = CeedMalloc(1, &fctx);
629d7b241e6Sjeremylt   if (*err) return;
630418fb8c2Sjeremylt   fctx->f = f; fctx->innerctx = NULL; fctx->innerctxsize = 0;
631d7b241e6Sjeremylt 
632418fb8c2Sjeremylt   *err = CeedQFunctionSetContext(*qf_, fctx, sizeof(fContext));
633d7b241e6Sjeremylt 
634418fb8c2Sjeremylt   (*qf_)->fortranstatus = true;
635d7b241e6Sjeremylt }
636d7b241e6Sjeremylt 
637288c0443SJeremy L Thompson #define fCeedQFunctionCreateInteriorByName \
638288c0443SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncreateinteriorbyname, CEEDQFUNCTIONCREATEINTERIORBYNAME)
639288c0443SJeremy L Thompson void fCeedQFunctionCreateInteriorByName(int *ceed, const char *name, int *qf,
640288c0443SJeremy L Thompson                                         int *err, fortran_charlen_t name_len) {
641288c0443SJeremy L Thompson   FIX_STRING(name);
642288c0443SJeremy L Thompson   if (CeedQFunction_count == CeedQFunction_count_max) {
643288c0443SJeremy L Thompson     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
644288c0443SJeremy L Thompson     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
645288c0443SJeremy L Thompson   }
646288c0443SJeremy L Thompson 
647288c0443SJeremy L Thompson   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
648288c0443SJeremy L Thompson   *err = CeedQFunctionCreateInteriorByName(Ceed_dict[*ceed], name_c, qf_);
649288c0443SJeremy L Thompson 
650288c0443SJeremy L Thompson   if (*err == 0) {
651288c0443SJeremy L Thompson     *qf = CeedQFunction_count++;
652288c0443SJeremy L Thompson     CeedQFunction_n++;
653288c0443SJeremy L Thompson   }
654288c0443SJeremy L Thompson }
655288c0443SJeremy L Thompson 
6560219ea01SJeremy L Thompson #define fCeedQFunctionCreateIdentity \
6570219ea01SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncreateidentity, CEEDQFUNCTIONCREATEIDENTITY)
65860f77c51Sjeremylt void fCeedQFunctionCreateIdentity(int *ceed, int *size, int *inmode,
65960f77c51Sjeremylt                                   int *outmode, int *qf, int *err) {
6600219ea01SJeremy L Thompson   if (CeedQFunction_count == CeedQFunction_count_max) {
6610219ea01SJeremy L Thompson     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
6620219ea01SJeremy L Thompson     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
6630219ea01SJeremy L Thompson   }
6640219ea01SJeremy L Thompson 
6650219ea01SJeremy L Thompson   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
666*399bb197SJed Brown   *err = CeedQFunctionCreateIdentity(Ceed_dict[*ceed], *size,
667*399bb197SJed Brown                                      (CeedEvalMode)*inmode,
668*399bb197SJed Brown                                      (CeedEvalMode)*outmode, qf_);
6690219ea01SJeremy L Thompson 
6700219ea01SJeremy L Thompson   if (*err == 0) {
6710219ea01SJeremy L Thompson     *qf = CeedQFunction_count++;
6720219ea01SJeremy L Thompson     CeedQFunction_n++;
6730219ea01SJeremy L Thompson   }
6740219ea01SJeremy L Thompson }
6750219ea01SJeremy L Thompson 
676d7b241e6Sjeremylt #define fCeedQFunctionAddInput \
677d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionaddinput,CEEDQFUNCTIONADDINPUT)
678d7b241e6Sjeremylt void fCeedQFunctionAddInput(int *qf, const char *fieldname,
679c2ae719dSJed Brown                             CeedInt *ncomp, CeedEvalMode *emode, int *err,
680c2ae719dSJed Brown                             fortran_charlen_t fieldname_len) {
681c2ae719dSJed Brown   FIX_STRING(fieldname);
682d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
683d7b241e6Sjeremylt 
684c2ae719dSJed Brown   *err = CeedQFunctionAddInput(qf_, fieldname_c, *ncomp, *emode);
685d7b241e6Sjeremylt }
686d7b241e6Sjeremylt 
687d7b241e6Sjeremylt #define fCeedQFunctionAddOutput \
688d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionaddoutput,CEEDQFUNCTIONADDOUTPUT)
689d7b241e6Sjeremylt void fCeedQFunctionAddOutput(int *qf, const char *fieldname,
690c2ae719dSJed Brown                              CeedInt *ncomp, CeedEvalMode *emode, int *err,
691c2ae719dSJed Brown                              fortran_charlen_t fieldname_len) {
692c2ae719dSJed Brown   FIX_STRING(fieldname);
693d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
694d7b241e6Sjeremylt 
695c2ae719dSJed Brown   *err = CeedQFunctionAddOutput(qf_, fieldname_c, *ncomp, *emode);
696d7b241e6Sjeremylt }
697d7b241e6Sjeremylt 
698418fb8c2Sjeremylt #define fCeedQFunctionSetContext \
699418fb8c2Sjeremylt     FORTRAN_NAME(ceedqfunctionsetcontext,CEEDQFUNCTIONSETCONTEXT)
700418fb8c2Sjeremylt void fCeedQFunctionSetContext(int *qf, CeedScalar *ctx, CeedInt *n, int *err) {
701418fb8c2Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
702418fb8c2Sjeremylt 
703418fb8c2Sjeremylt   fContext *fctx = qf_->ctx;
704418fb8c2Sjeremylt   fctx->innerctx = ctx;
7051e35832bSjeremylt   fctx->innerctxsize = ((size_t) *n)*sizeof(CeedScalar);
706418fb8c2Sjeremylt }
707418fb8c2Sjeremylt 
70875affc3bSjeremylt #define fCeedQFunctionView \
70975affc3bSjeremylt     FORTRAN_NAME(ceedqfunctionview,CEEDQFUNCTIONVIEW)
71075affc3bSjeremylt void fCeedQFunctionView(int *qf, int *err) {
71175affc3bSjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
71275affc3bSjeremylt 
71375affc3bSjeremylt   *err = CeedQFunctionView(qf_, stdout);
71475affc3bSjeremylt }
71575affc3bSjeremylt 
716d7b241e6Sjeremylt #define fCeedQFunctionApply \
717d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionapply,CEEDQFUNCTIONAPPLY)
718d7b241e6Sjeremylt //TODO Need Fixing, double pointer
719d7b241e6Sjeremylt void fCeedQFunctionApply(int *qf, int *Q,
720aedaa0e5Sjeremylt                          int *u, int *u1, int *u2, int *u3,
721aedaa0e5Sjeremylt                          int *u4, int *u5, int *u6, int *u7,
722aedaa0e5Sjeremylt                          int *u8, int *u9, int *u10, int *u11,
723aedaa0e5Sjeremylt                          int *u12, int *u13, int *u14, int *u15,
724aedaa0e5Sjeremylt                          int *v, int *v1, int *v2, int *v3,
725aedaa0e5Sjeremylt                          int *v4, int *v5, int *v6, int *v7,
726aedaa0e5Sjeremylt                          int *v8, int *v9, int *v10, int *v11,
727aedaa0e5Sjeremylt                          int *v12, int *v13, int *v14, int *v15, int *err) {
728d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
729aedaa0e5Sjeremylt   CeedVector *in;
730d7b241e6Sjeremylt   *err = CeedCalloc(16, &in);
731d7b241e6Sjeremylt   if (*err) return;
732aedaa0e5Sjeremylt   in[0] = *u==FORTRAN_NULL?NULL:CeedVector_dict[*u];
733aedaa0e5Sjeremylt   in[1] = *u1==FORTRAN_NULL?NULL:CeedVector_dict[*u1];
734aedaa0e5Sjeremylt   in[2] = *u2==FORTRAN_NULL?NULL:CeedVector_dict[*u2];
735aedaa0e5Sjeremylt   in[3] = *u3==FORTRAN_NULL?NULL:CeedVector_dict[*u3];
736aedaa0e5Sjeremylt   in[4] = *u4==FORTRAN_NULL?NULL:CeedVector_dict[*u4];
737aedaa0e5Sjeremylt   in[5] = *u5==FORTRAN_NULL?NULL:CeedVector_dict[*u5];
738aedaa0e5Sjeremylt   in[6] = *u6==FORTRAN_NULL?NULL:CeedVector_dict[*u6];
739aedaa0e5Sjeremylt   in[7] = *u7==FORTRAN_NULL?NULL:CeedVector_dict[*u7];
740aedaa0e5Sjeremylt   in[8] = *u8==FORTRAN_NULL?NULL:CeedVector_dict[*u8];
741aedaa0e5Sjeremylt   in[9] = *u9==FORTRAN_NULL?NULL:CeedVector_dict[*u9];
742aedaa0e5Sjeremylt   in[10] = *u10==FORTRAN_NULL?NULL:CeedVector_dict[*u10];
743aedaa0e5Sjeremylt   in[11] = *u11==FORTRAN_NULL?NULL:CeedVector_dict[*u11];
744aedaa0e5Sjeremylt   in[12] = *u12==FORTRAN_NULL?NULL:CeedVector_dict[*u12];
745aedaa0e5Sjeremylt   in[13] = *u13==FORTRAN_NULL?NULL:CeedVector_dict[*u13];
746aedaa0e5Sjeremylt   in[14] = *u14==FORTRAN_NULL?NULL:CeedVector_dict[*u14];
747aedaa0e5Sjeremylt   in[15] = *u15==FORTRAN_NULL?NULL:CeedVector_dict[*u15];
748aedaa0e5Sjeremylt   CeedVector *out;
749d7b241e6Sjeremylt   *err = CeedCalloc(16, &out);
750d7b241e6Sjeremylt   if (*err) return;
751aedaa0e5Sjeremylt   out[0] = *v==FORTRAN_NULL?NULL:CeedVector_dict[*v];
752aedaa0e5Sjeremylt   out[1] = *v1==FORTRAN_NULL?NULL:CeedVector_dict[*v1];
753aedaa0e5Sjeremylt   out[2] = *v2==FORTRAN_NULL?NULL:CeedVector_dict[*v2];
754aedaa0e5Sjeremylt   out[3] = *v3==FORTRAN_NULL?NULL:CeedVector_dict[*v3];
755aedaa0e5Sjeremylt   out[4] = *v4==FORTRAN_NULL?NULL:CeedVector_dict[*v4];
756aedaa0e5Sjeremylt   out[5] = *v5==FORTRAN_NULL?NULL:CeedVector_dict[*v5];
757aedaa0e5Sjeremylt   out[6] = *v6==FORTRAN_NULL?NULL:CeedVector_dict[*v6];
758aedaa0e5Sjeremylt   out[7] = *v7==FORTRAN_NULL?NULL:CeedVector_dict[*v7];
759aedaa0e5Sjeremylt   out[8] = *v8==FORTRAN_NULL?NULL:CeedVector_dict[*v8];
760aedaa0e5Sjeremylt   out[9] = *v9==FORTRAN_NULL?NULL:CeedVector_dict[*v9];
761aedaa0e5Sjeremylt   out[10] = *v10==FORTRAN_NULL?NULL:CeedVector_dict[*v10];
762aedaa0e5Sjeremylt   out[11] = *v11==FORTRAN_NULL?NULL:CeedVector_dict[*v11];
763aedaa0e5Sjeremylt   out[12] = *v12==FORTRAN_NULL?NULL:CeedVector_dict[*v12];
764aedaa0e5Sjeremylt   out[13] = *v13==FORTRAN_NULL?NULL:CeedVector_dict[*v13];
765aedaa0e5Sjeremylt   out[14] = *v14==FORTRAN_NULL?NULL:CeedVector_dict[*v14];
766aedaa0e5Sjeremylt   out[15] = *v15==FORTRAN_NULL?NULL:CeedVector_dict[*v15];
767aedaa0e5Sjeremylt   *err = CeedQFunctionApply(qf_, *Q, in, out);
768d7b241e6Sjeremylt   if (*err) return;
769d7b241e6Sjeremylt 
770d7b241e6Sjeremylt   *err = CeedFree(&in);
771d7b241e6Sjeremylt   if (*err) return;
772d7b241e6Sjeremylt   *err = CeedFree(&out);
773d7b241e6Sjeremylt }
774d7b241e6Sjeremylt 
775d7b241e6Sjeremylt #define fCeedQFunctionDestroy \
776d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctiondestroy,CEEDQFUNCTIONDESTROY)
777d7b241e6Sjeremylt void fCeedQFunctionDestroy(int *qf, int *err) {
7781134a487Sjeremylt   bool fstatus;
7791134a487Sjeremylt   *err = CeedQFunctionGetFortranStatus(CeedQFunction_dict[*qf], &fstatus);
7801134a487Sjeremylt   if (*err) return;
7811134a487Sjeremylt   if (fstatus) {
782c4b814baSjeremylt     fContext *fctx = CeedQFunction_dict[*qf]->ctx;
783c4b814baSjeremylt     *err = CeedFree(&fctx);
784d7b241e6Sjeremylt     if (*err) return;
7851134a487Sjeremylt   }
786c4b814baSjeremylt 
787c4b814baSjeremylt   *err = CeedQFunctionDestroy(&CeedQFunction_dict[*qf]);
788c4b814baSjeremylt   if (*err) return;
789c4b814baSjeremylt 
790d7b241e6Sjeremylt   CeedQFunction_n--;
791d7b241e6Sjeremylt   if (CeedQFunction_n == 0) {
792d7b241e6Sjeremylt     *err = CeedFree(&CeedQFunction_dict);
793d7b241e6Sjeremylt     CeedQFunction_count = 0;
794d7b241e6Sjeremylt     CeedQFunction_count_max = 0;
795d7b241e6Sjeremylt   }
796d7b241e6Sjeremylt }
797d7b241e6Sjeremylt 
798d7b241e6Sjeremylt static CeedOperator *CeedOperator_dict = NULL;
799d7b241e6Sjeremylt static int CeedOperator_count = 0;
800d7b241e6Sjeremylt static int CeedOperator_n = 0;
801d7b241e6Sjeremylt static int CeedOperator_count_max = 0;
802d7b241e6Sjeremylt 
803d7b241e6Sjeremylt #define fCeedOperatorCreate \
804d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorcreate, CEEDOPERATORCREATE)
805d7b241e6Sjeremylt void fCeedOperatorCreate(int *ceed,
806d7b241e6Sjeremylt                          int *qf, int *dqf, int *dqfT, int *op, int *err) {
807d7b241e6Sjeremylt   if (CeedOperator_count == CeedOperator_count_max)
808d7b241e6Sjeremylt     CeedOperator_count_max += CeedOperator_count_max/2 + 1,
8098795c945Sjeremylt                               CeedOperator_dict = realloc(CeedOperator_dict,
8108795c945Sjeremylt                                   sizeof(CeedOperator)*CeedOperator_count_max);
811d7b241e6Sjeremylt 
812d7b241e6Sjeremylt   CeedOperator *op_ = &CeedOperator_dict[CeedOperator_count];
813d7b241e6Sjeremylt 
814442e7f0bSjeremylt   CeedQFunction dqf_  = CEED_QFUNCTION_NONE, dqfT_ = CEED_QFUNCTION_NONE;
815442e7f0bSjeremylt   if (*dqf  != FORTRAN_QFUNCTION_NONE) dqf_  = CeedQFunction_dict[*dqf ];
816442e7f0bSjeremylt   if (*dqfT != FORTRAN_QFUNCTION_NONE) dqfT_ = CeedQFunction_dict[*dqfT];
817d7b241e6Sjeremylt 
818d7b241e6Sjeremylt   *err = CeedOperatorCreate(Ceed_dict[*ceed], CeedQFunction_dict[*qf], dqf_,
819d7b241e6Sjeremylt                             dqfT_, op_);
820d7b241e6Sjeremylt   if (*err) return;
821d7b241e6Sjeremylt   *op = CeedOperator_count++;
822d7b241e6Sjeremylt   CeedOperator_n++;
823d7b241e6Sjeremylt }
824d7b241e6Sjeremylt 
82552d6035fSJeremy L Thompson #define fCeedCompositeOperatorCreate \
82652d6035fSJeremy L Thompson     FORTRAN_NAME(ceedcompositeoperatorcreate, CEEDCOMPOSITEOPERATORCREATE)
82752d6035fSJeremy L Thompson void fCeedCompositeOperatorCreate(int *ceed, int *op, int *err) {
82852d6035fSJeremy L Thompson   if (CeedOperator_count == CeedOperator_count_max)
82952d6035fSJeremy L Thompson     CeedOperator_count_max += CeedOperator_count_max/2 + 1,
8308795c945Sjeremylt                               CeedOperator_dict = realloc(CeedOperator_dict,
8318795c945Sjeremylt                                   sizeof(CeedOperator)*CeedOperator_count_max);
83252d6035fSJeremy L Thompson 
83352d6035fSJeremy L Thompson   CeedOperator *op_ = &CeedOperator_dict[CeedOperator_count];
83452d6035fSJeremy L Thompson 
83552d6035fSJeremy L Thompson   *err = CeedCompositeOperatorCreate(Ceed_dict[*ceed], op_);
83652d6035fSJeremy L Thompson   if (*err) return;
83752d6035fSJeremy L Thompson   *op = CeedOperator_count++;
83852d6035fSJeremy L Thompson   CeedOperator_n++;
83952d6035fSJeremy L Thompson }
84052d6035fSJeremy L Thompson 
841d7b241e6Sjeremylt #define fCeedOperatorSetField \
842d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorsetfield,CEEDOPERATORSETFIELD)
843a8d32208Sjeremylt void fCeedOperatorSetField(int *op, const char *fieldname, int *r, int *b,
844a8d32208Sjeremylt                            int *v, int *err, fortran_charlen_t fieldname_len) {
845c2ae719dSJed Brown   FIX_STRING(fieldname);
846d7b241e6Sjeremylt   CeedElemRestriction r_;
847d7b241e6Sjeremylt   CeedBasis b_;
848d7b241e6Sjeremylt   CeedVector v_;
849d7b241e6Sjeremylt 
850d7b241e6Sjeremylt   CeedOperator op_ = CeedOperator_dict[*op];
851d7b241e6Sjeremylt 
852d7b241e6Sjeremylt   if (*r == FORTRAN_NULL) {
853d7b241e6Sjeremylt     r_ = NULL;
85415910d16Sjeremylt   } else if (*r == FORTRAN_ELEMRESTRICTION_NONE) {
85515910d16Sjeremylt     r_ = CEED_ELEMRESTRICTION_NONE;
856d7b241e6Sjeremylt   } else {
857d7b241e6Sjeremylt     r_ = CeedElemRestriction_dict[*r];
858d7b241e6Sjeremylt   }
8594dccadb6Sjeremylt 
860d7b241e6Sjeremylt   if (*b == FORTRAN_NULL) {
861d7b241e6Sjeremylt     b_ = NULL;
862783c99b3SValeria Barra   } else if (*b == FORTRAN_BASIS_COLLOCATED) {
863783c99b3SValeria Barra     b_ = CEED_BASIS_COLLOCATED;
864d7b241e6Sjeremylt   } else {
865d7b241e6Sjeremylt     b_ = CeedBasis_dict[*b];
866d7b241e6Sjeremylt   }
867d7b241e6Sjeremylt   if (*v == FORTRAN_NULL) {
868d7b241e6Sjeremylt     v_ = NULL;
869d7b241e6Sjeremylt   } else if (*v == FORTRAN_VECTOR_ACTIVE) {
870d7b241e6Sjeremylt     v_ = CEED_VECTOR_ACTIVE;
871d7b241e6Sjeremylt   } else if (*v == FORTRAN_VECTOR_NONE) {
872d7b241e6Sjeremylt     v_ = CEED_VECTOR_NONE;
873d7b241e6Sjeremylt   } else {
874d7b241e6Sjeremylt     v_ = CeedVector_dict[*v];
875d7b241e6Sjeremylt   }
876d7b241e6Sjeremylt 
877a8d32208Sjeremylt   *err = CeedOperatorSetField(op_, fieldname_c, r_, b_, v_);
878d7b241e6Sjeremylt }
879d7b241e6Sjeremylt 
88052d6035fSJeremy L Thompson #define fCeedCompositeOperatorAddSub \
88152d6035fSJeremy L Thompson     FORTRAN_NAME(ceedcompositeoperatoraddsub, CEEDCOMPOSITEOPERATORADDSUB)
88252d6035fSJeremy L Thompson void fCeedCompositeOperatorAddSub(int *compositeop, int *subop, int *err) {
88352d6035fSJeremy L Thompson   CeedOperator compositeop_ = CeedOperator_dict[*compositeop];
88452d6035fSJeremy L Thompson   CeedOperator subop_ = CeedOperator_dict[*subop];
88552d6035fSJeremy L Thompson 
88652d6035fSJeremy L Thompson   *err = CeedCompositeOperatorAddSub(compositeop_, subop_);
88752d6035fSJeremy L Thompson   if (*err) return;
88852d6035fSJeremy L Thompson }
88952d6035fSJeremy L Thompson 
8901d102b48SJeremy L Thompson #define fCeedOperatorAssembleLinearQFunction FORTRAN_NAME(ceedoperatorassemblelinearqfunction, CEEDOPERATORASSEMBLELINEARQFUNCTION)
8911d102b48SJeremy L Thompson void fCeedOperatorAssembleLinearQFunction(int *op, int *assembledvec,
8921d102b48SJeremy L Thompson     int *assembledrstr, int *rqst, int *err) {
8931d102b48SJeremy L Thompson   // Vector
8941d102b48SJeremy L Thompson   if (CeedVector_count == CeedVector_count_max) {
8951d102b48SJeremy L Thompson     CeedVector_count_max += CeedVector_count_max/2 + 1;
8961d102b48SJeremy L Thompson     CeedRealloc(CeedVector_count_max, &CeedVector_dict);
8971d102b48SJeremy L Thompson   }
8981d102b48SJeremy L Thompson   CeedVector *assembledvec_ = &CeedVector_dict[CeedVector_count];
8991d102b48SJeremy L Thompson 
9001d102b48SJeremy L Thompson   // Restriction
9011d102b48SJeremy L Thompson   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
9021d102b48SJeremy L Thompson     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
9031d102b48SJeremy L Thompson     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
9041d102b48SJeremy L Thompson   }
9051d102b48SJeremy L Thompson   CeedElemRestriction *rstr_ =
9061d102b48SJeremy L Thompson     &CeedElemRestriction_dict[CeedElemRestriction_count];
9071d102b48SJeremy L Thompson 
9081d102b48SJeremy L Thompson   int createRequest = 1;
9091d102b48SJeremy L Thompson   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
9101d102b48SJeremy L Thompson   if (*rqst == -1 || *rqst == -2) {
9111d102b48SJeremy L Thompson     createRequest = 0;
9121d102b48SJeremy L Thompson   }
9131d102b48SJeremy L Thompson 
9141d102b48SJeremy L Thompson   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
9151d102b48SJeremy L Thompson     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
9161d102b48SJeremy L Thompson     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
9171d102b48SJeremy L Thompson   }
9181d102b48SJeremy L Thompson 
9191d102b48SJeremy L Thompson   CeedRequest *rqst_;
9201d102b48SJeremy L Thompson   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
9211d102b48SJeremy L Thompson   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
9221d102b48SJeremy L Thompson   else rqst_ = &CeedRequest_dict[CeedRequest_count];
9231d102b48SJeremy L Thompson 
9241d102b48SJeremy L Thompson   *err = CeedOperatorAssembleLinearQFunction(CeedOperator_dict[*op],
9251d102b48SJeremy L Thompson          assembledvec_, rstr_, rqst_);
9261d102b48SJeremy L Thompson   if (*err) return;
9271d102b48SJeremy L Thompson   if (createRequest) {
9281d102b48SJeremy L Thompson     *rqst = CeedRequest_count++;
9291d102b48SJeremy L Thompson     CeedRequest_n++;
9301d102b48SJeremy L Thompson   }
9311d102b48SJeremy L Thompson 
9321d102b48SJeremy L Thompson   if (*err == 0) {
9331d102b48SJeremy L Thompson     *assembledrstr = CeedElemRestriction_count++;
9341d102b48SJeremy L Thompson     CeedElemRestriction_n++;
9351d102b48SJeremy L Thompson     *assembledvec = CeedVector_count++;
9361d102b48SJeremy L Thompson     CeedVector_n++;
9371d102b48SJeremy L Thompson   }
9381d102b48SJeremy L Thompson }
9391d102b48SJeremy L Thompson 
940b7ec98d8SJeremy L Thompson #define fCeedOperatorAssembleLinearDiagonal FORTRAN_NAME(ceedoperatorassemblelineardiagonal, CEEDOPERATORASSEMBLELINEARDIAGONAL)
941b7ec98d8SJeremy L Thompson void fCeedOperatorAssembleLinearDiagonal(int *op, int *assembledvec,
942b7ec98d8SJeremy L Thompson     int *rqst, int *err) {
943b7ec98d8SJeremy L Thompson   // Vector
944b7ec98d8SJeremy L Thompson   if (CeedVector_count == CeedVector_count_max) {
945b7ec98d8SJeremy L Thompson     CeedVector_count_max += CeedVector_count_max/2 + 1;
946b7ec98d8SJeremy L Thompson     CeedRealloc(CeedVector_count_max, &CeedVector_dict);
947b7ec98d8SJeremy L Thompson   }
948b7ec98d8SJeremy L Thompson   CeedVector *assembledvec_ = &CeedVector_dict[CeedVector_count];
949b7ec98d8SJeremy L Thompson 
950b7ec98d8SJeremy L Thompson   int createRequest = 1;
951b7ec98d8SJeremy L Thompson   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
952b7ec98d8SJeremy L Thompson   if (*rqst == -1 || *rqst == -2) {
953b7ec98d8SJeremy L Thompson     createRequest = 0;
954b7ec98d8SJeremy L Thompson   }
955b7ec98d8SJeremy L Thompson 
956b7ec98d8SJeremy L Thompson   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
957b7ec98d8SJeremy L Thompson     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
958b7ec98d8SJeremy L Thompson     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
959b7ec98d8SJeremy L Thompson   }
960b7ec98d8SJeremy L Thompson 
961b7ec98d8SJeremy L Thompson   CeedRequest *rqst_;
962b7ec98d8SJeremy L Thompson   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
963b7ec98d8SJeremy L Thompson   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
964b7ec98d8SJeremy L Thompson   else rqst_ = &CeedRequest_dict[CeedRequest_count];
965b7ec98d8SJeremy L Thompson 
966b7ec98d8SJeremy L Thompson   *err = CeedOperatorAssembleLinearDiagonal(CeedOperator_dict[*op],
967b7ec98d8SJeremy L Thompson          assembledvec_, rqst_);
968b7ec98d8SJeremy L Thompson   if (*err) return;
969b7ec98d8SJeremy L Thompson   if (createRequest) {
970b7ec98d8SJeremy L Thompson     *rqst = CeedRequest_count++;
971b7ec98d8SJeremy L Thompson     CeedRequest_n++;
972b7ec98d8SJeremy L Thompson   }
973b7ec98d8SJeremy L Thompson 
974b7ec98d8SJeremy L Thompson   if (*err == 0) {
975b7ec98d8SJeremy L Thompson     *assembledvec = CeedVector_count++;
976b7ec98d8SJeremy L Thompson     CeedVector_n++;
977b7ec98d8SJeremy L Thompson   }
978b7ec98d8SJeremy L Thompson }
979b7ec98d8SJeremy L Thompson 
9802ebaca42Sjeremylt #define fCeedOperatorView \
9812ebaca42Sjeremylt     FORTRAN_NAME(ceedoperatorview,CEEDOPERATORVIEW)
9822ebaca42Sjeremylt void fCeedOperatorView(int *op, int *err) {
9832ebaca42Sjeremylt   CeedOperator op_ = CeedOperator_dict[*op];
9842ebaca42Sjeremylt 
9852ebaca42Sjeremylt   *err = CeedOperatorView(op_, stdout);
9862ebaca42Sjeremylt }
9872ebaca42Sjeremylt 
9883bd813ffSjeremylt #define fCeedOperatorCreateFDMElementInverse FORTRAN_NAME(ceedoperatorcreatefdmelementinverse, CEEDOPERATORCREATEFDMELEMENTINVERSE)
9893bd813ffSjeremylt void fCeedOperatorCreateFDMElementInverse(int *op, int *fdminv,
9903bd813ffSjeremylt     int *rqst, int *err) {
9913bd813ffSjeremylt   // Operator
9923bd813ffSjeremylt   if (CeedOperator_count == CeedOperator_count_max) {
9933bd813ffSjeremylt     CeedOperator_count_max += CeedOperator_count_max/2 + 1;
9943bd813ffSjeremylt     CeedRealloc(CeedOperator_count_max, &CeedOperator_dict);
9953bd813ffSjeremylt   }
9963bd813ffSjeremylt   CeedOperator *fdminv_ =
9973bd813ffSjeremylt     &CeedOperator_dict[CeedOperator_count];
9983bd813ffSjeremylt 
9993bd813ffSjeremylt   int createRequest = 1;
10003bd813ffSjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
10013bd813ffSjeremylt   if (*rqst == -1 || *rqst == -2) {
10023bd813ffSjeremylt     createRequest = 0;
10033bd813ffSjeremylt   }
10043bd813ffSjeremylt 
10053bd813ffSjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
10063bd813ffSjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
10073bd813ffSjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
10083bd813ffSjeremylt   }
10093bd813ffSjeremylt 
10103bd813ffSjeremylt   CeedRequest *rqst_;
10113bd813ffSjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
10123bd813ffSjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
10133bd813ffSjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
10143bd813ffSjeremylt 
10153bd813ffSjeremylt   *err = CeedOperatorCreateFDMElementInverse(CeedOperator_dict[*op],
10163bd813ffSjeremylt          fdminv_, rqst_);
10173bd813ffSjeremylt   if (*err) return;
10183bd813ffSjeremylt   if (createRequest) {
10193bd813ffSjeremylt     *rqst = CeedRequest_count++;
10203bd813ffSjeremylt     CeedRequest_n++;
10213bd813ffSjeremylt   }
10223bd813ffSjeremylt 
10233bd813ffSjeremylt   if (*err == 0) {
10243bd813ffSjeremylt     *fdminv = CeedOperator_count++;
10253bd813ffSjeremylt     CeedOperator_n++;
10263bd813ffSjeremylt   }
10273bd813ffSjeremylt }
10283bd813ffSjeremylt 
1029d7b241e6Sjeremylt #define fCeedOperatorApply FORTRAN_NAME(ceedoperatorapply, CEEDOPERATORAPPLY)
1030d7b241e6Sjeremylt void fCeedOperatorApply(int *op, int *ustatevec,
1031d7b241e6Sjeremylt                         int *resvec, int *rqst, int *err) {
1032e97ff134Sjeremylt   CeedVector ustatevec_ = (*ustatevec == FORTRAN_NULL) ?
1033e97ff134Sjeremylt                           NULL : (*ustatevec == FORTRAN_VECTOR_NONE ?
1034e97ff134Sjeremylt                                   CEED_VECTOR_NONE : CeedVector_dict[*ustatevec]);
1035e97ff134Sjeremylt   CeedVector resvec_ = (*resvec == FORTRAN_NULL) ?
1036e97ff134Sjeremylt                        NULL : (*resvec == FORTRAN_VECTOR_NONE ?
1037e97ff134Sjeremylt                                CEED_VECTOR_NONE : CeedVector_dict[*resvec]);
1038d7b241e6Sjeremylt 
1039d7b241e6Sjeremylt   int createRequest = 1;
1040d7b241e6Sjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
1041d7b241e6Sjeremylt   if (*rqst == -1 || *rqst == -2) {
1042d7b241e6Sjeremylt     createRequest = 0;
1043d7b241e6Sjeremylt   }
1044d7b241e6Sjeremylt 
1045d7b241e6Sjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
1046d7b241e6Sjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
1047d7b241e6Sjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
1048d7b241e6Sjeremylt   }
1049d7b241e6Sjeremylt 
1050d7b241e6Sjeremylt   CeedRequest *rqst_;
1051d7b241e6Sjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
1052d7b241e6Sjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
1053d7b241e6Sjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
1054d7b241e6Sjeremylt 
1055d7b241e6Sjeremylt   *err = CeedOperatorApply(CeedOperator_dict[*op],
105612bf2c11SJed Brown                            ustatevec_, resvec_, rqst_);
1057d7b241e6Sjeremylt   if (*err) return;
1058d7b241e6Sjeremylt   if (createRequest) {
1059d7b241e6Sjeremylt     *rqst = CeedRequest_count++;
1060d7b241e6Sjeremylt     CeedRequest_n++;
1061d7b241e6Sjeremylt   }
1062d7b241e6Sjeremylt }
1063d7b241e6Sjeremylt 
1064cae8b89aSjeremylt #define fCeedOperatorApplyAdd FORTRAN_NAME(ceedoperatorapplyadd, CEEDOPERATORAPPLYADD)
1065cae8b89aSjeremylt void fCeedOperatorApplyAdd(int *op, int *ustatevec,
1066cae8b89aSjeremylt                            int *resvec, int *rqst, int *err) {
1067cae8b89aSjeremylt   CeedVector ustatevec_ = *ustatevec == FORTRAN_NULL
1068cae8b89aSjeremylt                           ? NULL : CeedVector_dict[*ustatevec];
1069cae8b89aSjeremylt   CeedVector resvec_ = *resvec == FORTRAN_NULL
1070cae8b89aSjeremylt                        ? NULL : CeedVector_dict[*resvec];
1071cae8b89aSjeremylt 
1072cae8b89aSjeremylt   int createRequest = 1;
1073cae8b89aSjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
1074cae8b89aSjeremylt   if (*rqst == -1 || *rqst == -2) {
1075cae8b89aSjeremylt     createRequest = 0;
1076cae8b89aSjeremylt   }
1077cae8b89aSjeremylt 
1078cae8b89aSjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
1079cae8b89aSjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
1080cae8b89aSjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
1081cae8b89aSjeremylt   }
1082cae8b89aSjeremylt 
1083cae8b89aSjeremylt   CeedRequest *rqst_;
1084cae8b89aSjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
1085cae8b89aSjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
1086cae8b89aSjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
1087cae8b89aSjeremylt 
1088cae8b89aSjeremylt   *err = CeedOperatorApplyAdd(CeedOperator_dict[*op],
1089cae8b89aSjeremylt                               ustatevec_, resvec_, rqst_);
1090cae8b89aSjeremylt   if (*err) return;
1091cae8b89aSjeremylt   if (createRequest) {
1092cae8b89aSjeremylt     *rqst = CeedRequest_count++;
1093cae8b89aSjeremylt     CeedRequest_n++;
1094cae8b89aSjeremylt   }
1095cae8b89aSjeremylt }
1096cae8b89aSjeremylt 
1097d7b241e6Sjeremylt #define fCeedOperatorApplyJacobian \
1098d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorapplyjacobian, CEEDOPERATORAPPLYJACOBIAN)
1099d7b241e6Sjeremylt void fCeedOperatorApplyJacobian(int *op, int *qdatavec, int *ustatevec,
11008795c945Sjeremylt                                 int *dustatevec, int *dresvec, int *rqst,
11018795c945Sjeremylt                                 int *err) {
1102d7b241e6Sjeremylt // TODO Uncomment this when CeedOperatorApplyJacobian is implemented
1103d7b241e6Sjeremylt //  *err = CeedOperatorApplyJacobian(CeedOperator_dict[*op], CeedVector_dict[*qdatavec],
1104d7b241e6Sjeremylt //             CeedVector_dict[*ustatevec], CeedVector_dict[*dustatevec],
1105d7b241e6Sjeremylt //             CeedVector_dict[*dresvec], &CeedRequest_dict[*rqst]);
1106d7b241e6Sjeremylt }
1107d7b241e6Sjeremylt 
1108d7b241e6Sjeremylt #define fCeedOperatorDestroy \
1109d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatordestroy, CEEDOPERATORDESTROY)
1110d7b241e6Sjeremylt void fCeedOperatorDestroy(int *op, int *err) {
1111d7b241e6Sjeremylt   *err = CeedOperatorDestroy(&CeedOperator_dict[*op]);
1112d7b241e6Sjeremylt   if (*err) return;
1113d7b241e6Sjeremylt   CeedOperator_n--;
1114d7b241e6Sjeremylt   if (CeedOperator_n == 0) {
1115d7b241e6Sjeremylt     *err = CeedFree(&CeedOperator_dict);
1116d7b241e6Sjeremylt     CeedOperator_count = 0;
1117d7b241e6Sjeremylt     CeedOperator_count_max = 0;
1118d7b241e6Sjeremylt   }
1119d7b241e6Sjeremylt }
1120