xref: /libCEED/rust/libceed-sys/c-src/interface/ceed-fortran.c (revision a8d322087fa8f150327cdc2bf14a171452b711ec)
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
28783c99b3SValeria Barra #define FORTRAN_BASIS_COLLOCATED -1
29d7b241e6Sjeremylt #define FORTRAN_VECTOR_ACTIVE -1
30d7b241e6Sjeremylt #define FORTRAN_VECTOR_NONE -2
31442e7f0bSjeremylt #define FORTRAN_QFUNCTION_NONE -1
32d7b241e6Sjeremylt 
33d7b241e6Sjeremylt static Ceed *Ceed_dict = NULL;
34d7b241e6Sjeremylt static int Ceed_count = 0;
35d7b241e6Sjeremylt static int Ceed_n = 0;
36d7b241e6Sjeremylt static int Ceed_count_max = 0;
37d7b241e6Sjeremylt 
38c2ae719dSJed Brown // This test should actually be for the gfortran version, but we don't currently
39c2ae719dSJed Brown // have a configure system to determine that (TODO).  At present, this will use
40c2ae719dSJed Brown // the smaller integer when run with clang+gfortran=8, for example.  (That is
41c2ae719dSJed Brown // sketchy, but will likely work for users that don't have huge character
42c2ae719dSJed Brown // strings.)
43c2ae719dSJed Brown #if __GNUC__ >= 8
44c2ae719dSJed Brown typedef size_t fortran_charlen_t;
45c2ae719dSJed Brown #else
46c2ae719dSJed Brown typedef int fortran_charlen_t;
47c2ae719dSJed Brown #endif
48c2ae719dSJed Brown 
49c2ae719dSJed Brown #define Splice(a, b) a ## b
50c2ae719dSJed Brown 
51c2ae719dSJed Brown // Fortran strings are generally unterminated and the length is passed as an
52c2ae719dSJed Brown // extra argument after all the normal arguments.  Some compilers (I only know
53c2ae719dSJed Brown // of Windows) place the length argument immediately after the string parameter
54c2ae719dSJed Brown // (TODO).
55c2ae719dSJed Brown //
56c2ae719dSJed Brown // We can't just NULL-terminate the string in-place because that could overwrite
57c2ae719dSJed Brown // other strings or attempt to write to read-only memory.  This macro allocates
58c2ae719dSJed Brown // a string to hold the null-terminated version of the string that C expects.
59c2ae719dSJed Brown #define FIX_STRING(stringname)                                          \
60c2ae719dSJed Brown   char Splice(stringname, _c)[1024];                                    \
61c2ae719dSJed Brown   if (Splice(stringname, _len) > 1023)                                  \
62c2ae719dSJed Brown     CeedError(NULL, 1, "Fortran string length too long %zd", (size_t)Splice(stringname, _len)); \
63c2ae719dSJed Brown   strncpy(Splice(stringname, _c), stringname, Splice(stringname, _len)); \
64c2ae719dSJed Brown   Splice(stringname, _c)[Splice(stringname, _len)] = 0;                 \
65c2ae719dSJed Brown 
66d7b241e6Sjeremylt #define fCeedInit FORTRAN_NAME(ceedinit,CEEDINIT)
67c2ae719dSJed Brown void fCeedInit(const char *resource, int *ceed, int *err,
68c2ae719dSJed Brown                fortran_charlen_t resource_len) {
69c2ae719dSJed Brown   FIX_STRING(resource);
70d7b241e6Sjeremylt   if (Ceed_count == Ceed_count_max) {
71d7b241e6Sjeremylt     Ceed_count_max += Ceed_count_max/2 + 1;
72d7b241e6Sjeremylt     CeedRealloc(Ceed_count_max, &Ceed_dict);
73d7b241e6Sjeremylt   }
74d7b241e6Sjeremylt 
75d7b241e6Sjeremylt   Ceed *ceed_ = &Ceed_dict[Ceed_count];
76c2ae719dSJed Brown   *err = CeedInit(resource_c, ceed_);
77d7b241e6Sjeremylt 
78d7b241e6Sjeremylt   if (*err == 0) {
79d7b241e6Sjeremylt     *ceed = Ceed_count++;
80d7b241e6Sjeremylt     Ceed_n++;
81d7b241e6Sjeremylt   }
82d7b241e6Sjeremylt }
83d7b241e6Sjeremylt 
84c907536fSjeremylt #define fCeedGetPreferredMemType \
85c907536fSjeremylt     FORTRAN_NAME(ceedgetpreferredmemtype,CEEDGETPREFERREDMEMTYPE)
86c907536fSjeremylt void fCeedGetPreferredMemType(int *ceed, int *type, int *err) {
87c907536fSjeremylt   *err = CeedGetPreferredMemType(Ceed_dict[*ceed], (CeedMemType *)type);
88c907536fSjeremylt }
89c907536fSjeremylt 
90d7b241e6Sjeremylt #define fCeedDestroy FORTRAN_NAME(ceeddestroy,CEEDDESTROY)
91d7b241e6Sjeremylt void fCeedDestroy(int *ceed, int *err) {
92d7b241e6Sjeremylt   *err = CeedDestroy(&Ceed_dict[*ceed]);
93d7b241e6Sjeremylt 
94d7b241e6Sjeremylt   if (*err == 0) {
95d7b241e6Sjeremylt     Ceed_n--;
96d7b241e6Sjeremylt     if (Ceed_n == 0) {
97d7b241e6Sjeremylt       CeedFree(&Ceed_dict);
98d7b241e6Sjeremylt       Ceed_count = 0;
99d7b241e6Sjeremylt       Ceed_count_max = 0;
100d7b241e6Sjeremylt     }
101d7b241e6Sjeremylt   }
102d7b241e6Sjeremylt }
103d7b241e6Sjeremylt 
104d7b241e6Sjeremylt static CeedVector *CeedVector_dict = NULL;
105d7b241e6Sjeremylt static int CeedVector_count = 0;
106d7b241e6Sjeremylt static int CeedVector_n = 0;
107d7b241e6Sjeremylt static int CeedVector_count_max = 0;
108d7b241e6Sjeremylt 
109d7b241e6Sjeremylt #define fCeedVectorCreate FORTRAN_NAME(ceedvectorcreate,CEEDVECTORCREATE)
110d7b241e6Sjeremylt void fCeedVectorCreate(int *ceed, int *length, int *vec, int *err) {
111d7b241e6Sjeremylt   if (CeedVector_count == CeedVector_count_max) {
112d7b241e6Sjeremylt     CeedVector_count_max += CeedVector_count_max/2 + 1;
113d7b241e6Sjeremylt     CeedRealloc(CeedVector_count_max, &CeedVector_dict);
114d7b241e6Sjeremylt   }
115d7b241e6Sjeremylt 
116d7b241e6Sjeremylt   CeedVector *vec_ = &CeedVector_dict[CeedVector_count];
117d7b241e6Sjeremylt   *err = CeedVectorCreate(Ceed_dict[*ceed], *length, vec_);
118d7b241e6Sjeremylt 
119d7b241e6Sjeremylt   if (*err == 0) {
120d7b241e6Sjeremylt     *vec = CeedVector_count++;
121d7b241e6Sjeremylt     CeedVector_n++;
122d7b241e6Sjeremylt   }
123d7b241e6Sjeremylt }
124d7b241e6Sjeremylt 
125d7b241e6Sjeremylt #define fCeedVectorSetArray FORTRAN_NAME(ceedvectorsetarray,CEEDVECTORSETARRAY)
126d7b241e6Sjeremylt void fCeedVectorSetArray(int *vec, int *memtype, int *copymode,
127c8b9fe72Sjeremylt                          CeedScalar *array, int64_t *offset, int *err) {
128c8b9fe72Sjeremylt   *err = CeedVectorSetArray(CeedVector_dict[*vec], *memtype, *copymode,
129c8b9fe72Sjeremylt                             (CeedScalar *)(array + *offset));
130d7b241e6Sjeremylt }
131d7b241e6Sjeremylt 
13254540941SJeremy L Thompson #define fCeedVectorSyncArray FORTRAN_NAME(ceedvectorsyncarray,CEEDVECTORSYNCARRAY)
13354540941SJeremy L Thompson void fCeedVectorSyncArray(int *vec, int *memtype, int *err) {
13454540941SJeremy L Thompson   *err = CeedVectorSyncArray(CeedVector_dict[*vec], *memtype);
13554540941SJeremy L Thompson }
13654540941SJeremy L Thompson 
137d7b241e6Sjeremylt #define fCeedVectorSetValue FORTRAN_NAME(ceedvectorsetvalue,CEEDVECTORSETVALUE)
138d7b241e6Sjeremylt void fCeedVectorSetValue(int *vec, CeedScalar *value, int *err) {
139d7b241e6Sjeremylt   *err = CeedVectorSetValue(CeedVector_dict[*vec], *value);
140d7b241e6Sjeremylt }
141d7b241e6Sjeremylt 
142d7b241e6Sjeremylt #define fCeedVectorGetArray FORTRAN_NAME(ceedvectorgetarray,CEEDVECTORGETARRAY)
143a8de75f0Sjeremylt void fCeedVectorGetArray(int *vec, int *memtype, CeedScalar *array,
144a8de75f0Sjeremylt                          int64_t *offset,
145cbfd6a90SThilina Rathnayake                          int *err) {
146d7b241e6Sjeremylt   CeedScalar *b;
147d7b241e6Sjeremylt   CeedVector vec_ = CeedVector_dict[*vec];
148d7b241e6Sjeremylt   *err = CeedVectorGetArray(vec_, *memtype, &b);
149cbfd6a90SThilina Rathnayake   *offset = b - array;
150d7b241e6Sjeremylt }
151d7b241e6Sjeremylt 
152d7b241e6Sjeremylt #define fCeedVectorGetArrayRead \
153d7b241e6Sjeremylt     FORTRAN_NAME(ceedvectorgetarrayread,CEEDVECTORGETARRAYREAD)
154d7b241e6Sjeremylt void fCeedVectorGetArrayRead(int *vec, int *memtype, CeedScalar *array,
1553334379fSJed Brown                              int64_t *offset, int *err) {
156d7b241e6Sjeremylt   const CeedScalar *b;
157d7b241e6Sjeremylt   CeedVector vec_ = CeedVector_dict[*vec];
158cbfd6a90SThilina Rathnayake   *err = CeedVectorGetArrayRead(vec_, *memtype, &b);
159cbfd6a90SThilina Rathnayake   *offset = b - array;
160d7b241e6Sjeremylt }
161d7b241e6Sjeremylt 
162d7b241e6Sjeremylt #define fCeedVectorRestoreArray \
163d7b241e6Sjeremylt     FORTRAN_NAME(ceedvectorrestorearray,CEEDVECTORRESTOREARRAY)
1646456524eSJed Brown void fCeedVectorRestoreArray(int *vec, CeedScalar *array,
1656456524eSJed Brown                              int64_t *offset, int *err) {
166d7b241e6Sjeremylt   *err = CeedVectorRestoreArray(CeedVector_dict[*vec], &array);
1676456524eSJed Brown   *offset = 0;
168d7b241e6Sjeremylt }
169d7b241e6Sjeremylt 
170d7b241e6Sjeremylt #define fCeedVectorRestoreArrayRead \
171d7b241e6Sjeremylt     FORTRAN_NAME(ceedvectorrestorearrayread,CEEDVECTORRESTOREARRAYREAD)
1726456524eSJed Brown void fCeedVectorRestoreArrayRead(int *vec, const CeedScalar *array,
1736456524eSJed Brown                                  int64_t *offset, int *err) {
174d7b241e6Sjeremylt   *err = CeedVectorRestoreArrayRead(CeedVector_dict[*vec], &array);
1756456524eSJed Brown   *offset = 0;
176d7b241e6Sjeremylt }
177d7b241e6Sjeremylt 
178547d9b97Sjeremylt #define fCeedVectorNorm \
179547d9b97Sjeremylt     FORTRAN_NAME(ceedvectornorm,CEEDVECTORNORM)
180547d9b97Sjeremylt void fCeedVectorNorm(int *vec, int *type, CeedScalar *norm, int *err) {
181547d9b97Sjeremylt   *err = CeedVectorNorm(CeedVector_dict[*vec], *type, norm);
182547d9b97Sjeremylt }
183547d9b97Sjeremylt 
184d7b241e6Sjeremylt #define fCeedVectorView FORTRAN_NAME(ceedvectorview,CEEDVECTORVIEW)
185d7b241e6Sjeremylt void fCeedVectorView(int *vec, int *err) {
186d7b241e6Sjeremylt   *err = CeedVectorView(CeedVector_dict[*vec], "%12.8f", stdout);
187d7b241e6Sjeremylt }
188d7b241e6Sjeremylt 
189d7b241e6Sjeremylt #define fCeedVectorDestroy FORTRAN_NAME(ceedvectordestroy,CEEDVECTORDESTROY)
190d7b241e6Sjeremylt void fCeedVectorDestroy(int *vec, int *err) {
191d7b241e6Sjeremylt   *err = CeedVectorDestroy(&CeedVector_dict[*vec]);
192d7b241e6Sjeremylt 
193d7b241e6Sjeremylt   if (*err == 0) {
194d7b241e6Sjeremylt     CeedVector_n--;
195d7b241e6Sjeremylt     if (CeedVector_n == 0) {
196d7b241e6Sjeremylt       CeedFree(&CeedVector_dict);
197d7b241e6Sjeremylt       CeedVector_count = 0;
198d7b241e6Sjeremylt       CeedVector_count_max = 0;
199d7b241e6Sjeremylt     }
200d7b241e6Sjeremylt   }
201d7b241e6Sjeremylt }
202d7b241e6Sjeremylt 
203d7b241e6Sjeremylt static CeedElemRestriction *CeedElemRestriction_dict = NULL;
204d7b241e6Sjeremylt static int CeedElemRestriction_count = 0;
205d7b241e6Sjeremylt static int CeedElemRestriction_n = 0;
206d7b241e6Sjeremylt static int CeedElemRestriction_count_max = 0;
207d7b241e6Sjeremylt 
208d7b241e6Sjeremylt #define fCeedElemRestrictionCreate \
209d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictioncreate, CEEDELEMRESTRICTIONCREATE)
210*a8d32208Sjeremylt void fCeedElemRestrictionCreate(int *ceed, int *lmode, int *nelements,
2118795c945Sjeremylt                                 int *esize, int *nnodes, int *ncomp,
2128795c945Sjeremylt                                 int *memtype, int *copymode, const int *indices,
2138795c945Sjeremylt                                 int *elemrestriction, int *err) {
214d7b241e6Sjeremylt   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
215d7b241e6Sjeremylt     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
216d7b241e6Sjeremylt     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
217d7b241e6Sjeremylt   }
218d7b241e6Sjeremylt 
219d7b241e6Sjeremylt   const int *indices_ = indices;
220d7b241e6Sjeremylt 
221d7b241e6Sjeremylt   CeedElemRestriction *elemrestriction_ =
222d7b241e6Sjeremylt     &CeedElemRestriction_dict[CeedElemRestriction_count];
223*a8d32208Sjeremylt   *err = CeedElemRestrictionCreate(Ceed_dict[*ceed], *lmode, *nelements, *esize,
2248795c945Sjeremylt                                    *nnodes, *ncomp, *memtype, *copymode,
2258795c945Sjeremylt                                    indices_, elemrestriction_);
226d7b241e6Sjeremylt 
227d7b241e6Sjeremylt   if (*err == 0) {
228d7b241e6Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
229d7b241e6Sjeremylt     CeedElemRestriction_n++;
230d7b241e6Sjeremylt   }
231d7b241e6Sjeremylt }
232d7b241e6Sjeremylt 
233d7b241e6Sjeremylt #define fCeedElemRestrictionCreateIdentity \
234d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictioncreateidentity, CEEDELEMRESTRICTIONCREATEIDENTITY)
235*a8d32208Sjeremylt void fCeedElemRestrictionCreateIdentity(int *ceed, int *lmode, int *nelements,
2368795c945Sjeremylt                                         int *esize, int *nnodes, int *ncomp,
237d7b241e6Sjeremylt                                         int *elemrestriction, int *err) {
238d7b241e6Sjeremylt   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
239d7b241e6Sjeremylt     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
240d7b241e6Sjeremylt     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
241d7b241e6Sjeremylt   }
242d7b241e6Sjeremylt 
243d7b241e6Sjeremylt   CeedElemRestriction *elemrestriction_ =
244d7b241e6Sjeremylt     &CeedElemRestriction_dict[CeedElemRestriction_count];
245*a8d32208Sjeremylt   *err = CeedElemRestrictionCreateIdentity(Ceed_dict[*ceed], *lmode, *nelements,
246*a8d32208Sjeremylt          *esize, *nnodes, *ncomp, elemrestriction_);
247d7b241e6Sjeremylt 
248d7b241e6Sjeremylt   if (*err == 0) {
249d7b241e6Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
250d7b241e6Sjeremylt     CeedElemRestriction_n++;
251d7b241e6Sjeremylt   }
252d7b241e6Sjeremylt }
253d7b241e6Sjeremylt 
254d7b241e6Sjeremylt #define fCeedElemRestrictionCreateBlocked \
255d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictioncreateblocked,CEEDELEMRESTRICTIONCREATEBLOCKED)
256*a8d32208Sjeremylt void fCeedElemRestrictionCreateBlocked(int *ceed, int *lmode, int *nelements,
2578795c945Sjeremylt                                        int *esize, int *blocksize, int *nnodes,
2588795c945Sjeremylt                                        int *ncomp, int *mtype, int *cmode,
2598795c945Sjeremylt                                        int *blkindices, int *elemrestriction,
2608795c945Sjeremylt                                        int *err) {
261d7b241e6Sjeremylt 
262d7b241e6Sjeremylt   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
263d7b241e6Sjeremylt     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
264d7b241e6Sjeremylt     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
265d7b241e6Sjeremylt   }
266d7b241e6Sjeremylt 
267d7b241e6Sjeremylt   CeedElemRestriction *elemrestriction_ =
268d7b241e6Sjeremylt     &CeedElemRestriction_dict[CeedElemRestriction_count];
269*a8d32208Sjeremylt   *err = CeedElemRestrictionCreateBlocked(Ceed_dict[*ceed], *lmode, *nelements,
270*a8d32208Sjeremylt                                           *esize, *blocksize, *nnodes, *ncomp,
271*a8d32208Sjeremylt                                           *mtype, *cmode, blkindices,
272*a8d32208Sjeremylt                                           elemrestriction_);
273d7b241e6Sjeremylt 
274d7b241e6Sjeremylt   if (*err == 0) {
275d7b241e6Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
276d7b241e6Sjeremylt     CeedElemRestriction_n++;
277d7b241e6Sjeremylt   }
278d7b241e6Sjeremylt }
279d7b241e6Sjeremylt 
280d7b241e6Sjeremylt static CeedRequest *CeedRequest_dict = NULL;
281d7b241e6Sjeremylt static int CeedRequest_count = 0;
282d7b241e6Sjeremylt static int CeedRequest_n = 0;
283d7b241e6Sjeremylt static int CeedRequest_count_max = 0;
284d7b241e6Sjeremylt 
285d7b241e6Sjeremylt #define fCeedElemRestrictionApply \
286d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictionapply,CEEDELEMRESTRICTIONAPPLY)
287*a8d32208Sjeremylt void fCeedElemRestrictionApply(int *elemr, int *tmode, int *uvec, int *ruvec,
288*a8d32208Sjeremylt                                int *rqst, int *err) {
289d7b241e6Sjeremylt   int createRequest = 1;
290d7b241e6Sjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
291d7b241e6Sjeremylt   if (*rqst == FORTRAN_REQUEST_IMMEDIATE || *rqst == FORTRAN_REQUEST_ORDERED)
292d7b241e6Sjeremylt     createRequest = 0;
293d7b241e6Sjeremylt 
294d7b241e6Sjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
295d7b241e6Sjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
296d7b241e6Sjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
297d7b241e6Sjeremylt   }
298d7b241e6Sjeremylt 
299d7b241e6Sjeremylt   CeedRequest *rqst_;
300d7b241e6Sjeremylt   if      (*rqst == FORTRAN_REQUEST_IMMEDIATE) rqst_ = CEED_REQUEST_IMMEDIATE;
301d7b241e6Sjeremylt   else if (*rqst == FORTRAN_REQUEST_ORDERED  ) rqst_ = CEED_REQUEST_ORDERED;
302d7b241e6Sjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
303d7b241e6Sjeremylt 
304d7b241e6Sjeremylt   *err = CeedElemRestrictionApply(CeedElemRestriction_dict[*elemr], *tmode,
305*a8d32208Sjeremylt                                   CeedVector_dict[*uvec],
3068795c945Sjeremylt                                   CeedVector_dict[*ruvec], rqst_);
307d7b241e6Sjeremylt 
308d7b241e6Sjeremylt   if (*err == 0 && createRequest) {
309d7b241e6Sjeremylt     *rqst = CeedRequest_count++;
310d7b241e6Sjeremylt     CeedRequest_n++;
311d7b241e6Sjeremylt   }
312d7b241e6Sjeremylt }
313d7b241e6Sjeremylt 
314be9261b7Sjeremylt #define fCeedElemRestrictionApplyBlock \
315be9261b7Sjeremylt     FORTRAN_NAME(ceedelemrestrictionapplyblock,CEEDELEMRESTRICTIONAPPLYBLOCK)
316f90c8643Sjeremylt void fCeedElemRestrictionApplyBlock(int *elemr, int *block, int *tmode,
317be9261b7Sjeremylt                                     int *uvec, int *ruvec, int *rqst, int *err) {
318be9261b7Sjeremylt   int createRequest = 1;
319be9261b7Sjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
320be9261b7Sjeremylt   if (*rqst == FORTRAN_REQUEST_IMMEDIATE || *rqst == FORTRAN_REQUEST_ORDERED)
321be9261b7Sjeremylt     createRequest = 0;
322be9261b7Sjeremylt 
323be9261b7Sjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
324be9261b7Sjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
325be9261b7Sjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
326be9261b7Sjeremylt   }
327be9261b7Sjeremylt 
328be9261b7Sjeremylt   CeedRequest *rqst_;
329be9261b7Sjeremylt   if      (*rqst == FORTRAN_REQUEST_IMMEDIATE) rqst_ = CEED_REQUEST_IMMEDIATE;
330be9261b7Sjeremylt   else if (*rqst == FORTRAN_REQUEST_ORDERED  ) rqst_ = CEED_REQUEST_ORDERED;
331be9261b7Sjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
332be9261b7Sjeremylt 
333be9261b7Sjeremylt   *err = CeedElemRestrictionApplyBlock(CeedElemRestriction_dict[*elemr], *block,
334*a8d32208Sjeremylt                                        *tmode, CeedVector_dict[*uvec],
335be9261b7Sjeremylt                                        CeedVector_dict[*ruvec], rqst_);
336be9261b7Sjeremylt 
337be9261b7Sjeremylt   if (*err == 0 && createRequest) {
338be9261b7Sjeremylt     *rqst = CeedRequest_count++;
339be9261b7Sjeremylt     CeedRequest_n++;
340be9261b7Sjeremylt   }
341be9261b7Sjeremylt }
342be9261b7Sjeremylt 
3431469ee4dSjeremylt #define fCeedElemRestrictionGetMultiplicity \
3441469ee4dSjeremylt     FORTRAN_NAME(ceedelemrestrictiongetmultiplicity,CEEDELEMRESTRICTIONGETMULTIPLICITY)
345*a8d32208Sjeremylt void fCeedElemRestrictionGetMultiplicity(int *elemr, int *mult, int *err) {
3461469ee4dSjeremylt   *err = CeedElemRestrictionGetMultiplicity(CeedElemRestriction_dict[*elemr],
347*a8d32208Sjeremylt          CeedVector_dict[*mult]);
3481469ee4dSjeremylt }
3491469ee4dSjeremylt 
3505a86f033Sjeremylt #define fCeedElemRestrictionView \
3515a86f033Sjeremylt     FORTRAN_NAME(ceedelemrestrictionview,CEEDELEMRESTRICTIONVIEW)
3525a86f033Sjeremylt void fCeedElemRestrictionView(int *elemr, int *err) {
3535a86f033Sjeremylt   *err = CeedElemRestrictionView(CeedElemRestriction_dict[*elemr], stdout);
3545a86f033Sjeremylt }
3551469ee4dSjeremylt 
356d7b241e6Sjeremylt #define fCeedRequestWait FORTRAN_NAME(ceedrequestwait, CEEDREQUESTWAIT)
357d7b241e6Sjeremylt void fCeedRequestWait(int *rqst, int *err) {
358d7b241e6Sjeremylt   // TODO Uncomment this once CeedRequestWait is implemented
359d7b241e6Sjeremylt   //*err = CeedRequestWait(&CeedRequest_dict[*rqst]);
360d7b241e6Sjeremylt 
361d7b241e6Sjeremylt   if (*err == 0) {
362d7b241e6Sjeremylt     CeedRequest_n--;
363d7b241e6Sjeremylt     if (CeedRequest_n == 0) {
364d7b241e6Sjeremylt       CeedFree(&CeedRequest_dict);
365d7b241e6Sjeremylt       CeedRequest_count = 0;
366d7b241e6Sjeremylt       CeedRequest_count_max = 0;
367d7b241e6Sjeremylt     }
368d7b241e6Sjeremylt   }
369d7b241e6Sjeremylt }
370d7b241e6Sjeremylt 
371d7b241e6Sjeremylt #define fCeedElemRestrictionDestroy \
372d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictiondestroy,CEEDELEMRESTRICTIONDESTROY)
373d7b241e6Sjeremylt void fCeedElemRestrictionDestroy(int *elem, int *err) {
374d7b241e6Sjeremylt   *err = CeedElemRestrictionDestroy(&CeedElemRestriction_dict[*elem]);
375d7b241e6Sjeremylt 
376d7b241e6Sjeremylt   if (*err == 0) {
377d7b241e6Sjeremylt     CeedElemRestriction_n--;
378d7b241e6Sjeremylt     if (CeedElemRestriction_n == 0) {
379d7b241e6Sjeremylt       CeedFree(&CeedElemRestriction_dict);
380d7b241e6Sjeremylt       CeedElemRestriction_count = 0;
381d7b241e6Sjeremylt       CeedElemRestriction_count_max = 0;
382d7b241e6Sjeremylt     }
383d7b241e6Sjeremylt   }
384d7b241e6Sjeremylt }
385d7b241e6Sjeremylt 
386d7b241e6Sjeremylt static CeedBasis *CeedBasis_dict = NULL;
387d7b241e6Sjeremylt static int CeedBasis_count = 0;
388d7b241e6Sjeremylt static int CeedBasis_n = 0;
389d7b241e6Sjeremylt static int CeedBasis_count_max = 0;
390d7b241e6Sjeremylt 
391d7b241e6Sjeremylt #define fCeedBasisCreateTensorH1Lagrange \
392d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasiscreatetensorh1lagrange, CEEDBASISCREATETENSORH1LAGRANGE)
393d7b241e6Sjeremylt void fCeedBasisCreateTensorH1Lagrange(int *ceed, int *dim,
3948795c945Sjeremylt                                       int *ncomp, int *P, int *Q, int *quadmode,
3958795c945Sjeremylt                                       int *basis, int *err) {
396d7b241e6Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
397d7b241e6Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
398d7b241e6Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
399d7b241e6Sjeremylt   }
400d7b241e6Sjeremylt 
401a8de75f0Sjeremylt   *err = CeedBasisCreateTensorH1Lagrange(Ceed_dict[*ceed], *dim, *ncomp, *P, *Q,
4028795c945Sjeremylt                                          *quadmode,
4038795c945Sjeremylt                                          &CeedBasis_dict[CeedBasis_count]);
404d7b241e6Sjeremylt 
405d7b241e6Sjeremylt   if (*err == 0) {
406d7b241e6Sjeremylt     *basis = CeedBasis_count++;
407d7b241e6Sjeremylt     CeedBasis_n++;
408d7b241e6Sjeremylt   }
409d7b241e6Sjeremylt }
410d7b241e6Sjeremylt 
411d7b241e6Sjeremylt #define fCeedBasisCreateTensorH1 \
412d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasiscreatetensorh1, CEEDBASISCREATETENSORH1)
413a8de75f0Sjeremylt void fCeedBasisCreateTensorH1(int *ceed, int *dim, int *ncomp, int *P1d,
4148795c945Sjeremylt                               int *Q1d, const CeedScalar *interp1d,
4158795c945Sjeremylt                               const CeedScalar *grad1d,
4168795c945Sjeremylt                               const CeedScalar *qref1d,
4178795c945Sjeremylt                               const CeedScalar *qweight1d, int *basis,
4188795c945Sjeremylt                               int *err) {
419d7b241e6Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
420d7b241e6Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
421d7b241e6Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
422d7b241e6Sjeremylt   }
423d7b241e6Sjeremylt 
424a8de75f0Sjeremylt   *err = CeedBasisCreateTensorH1(Ceed_dict[*ceed], *dim, *ncomp, *P1d, *Q1d,
4258795c945Sjeremylt                                  interp1d, grad1d, qref1d, qweight1d,
4268795c945Sjeremylt                                  &CeedBasis_dict[CeedBasis_count]);
427d7b241e6Sjeremylt 
428d7b241e6Sjeremylt   if (*err == 0) {
429d7b241e6Sjeremylt     *basis = CeedBasis_count++;
430d7b241e6Sjeremylt     CeedBasis_n++;
431d7b241e6Sjeremylt   }
432d7b241e6Sjeremylt }
433d7b241e6Sjeremylt 
434a8de75f0Sjeremylt #define fCeedBasisCreateH1 \
435a8de75f0Sjeremylt     FORTRAN_NAME(ceedbasiscreateh1, CEEDBASISCREATEH1)
4368795c945Sjeremylt void fCeedBasisCreateH1(int *ceed, int *topo, int *ncomp, int *nnodes,
4378795c945Sjeremylt                         int *nqpts, const CeedScalar *interp,
4388795c945Sjeremylt                         const CeedScalar *grad, const CeedScalar *qref,
4398795c945Sjeremylt                         const CeedScalar *qweight, int *basis, int *err) {
440a8de75f0Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
441a8de75f0Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
442a8de75f0Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
443a8de75f0Sjeremylt   }
444a8de75f0Sjeremylt 
4458795c945Sjeremylt   *err = CeedBasisCreateH1(Ceed_dict[*ceed], *topo, *ncomp, *nnodes, *nqpts,
4468795c945Sjeremylt                            interp, grad, qref, qweight,
4478795c945Sjeremylt                            &CeedBasis_dict[CeedBasis_count]);
448a8de75f0Sjeremylt 
449a8de75f0Sjeremylt   if (*err == 0) {
450a8de75f0Sjeremylt     *basis = CeedBasis_count++;
451a8de75f0Sjeremylt     CeedBasis_n++;
452a8de75f0Sjeremylt   }
453a8de75f0Sjeremylt }
454a8de75f0Sjeremylt 
455d7b241e6Sjeremylt #define fCeedBasisView FORTRAN_NAME(ceedbasisview, CEEDBASISVIEW)
456d7b241e6Sjeremylt void fCeedBasisView(int *basis, int *err) {
457d7b241e6Sjeremylt   *err = CeedBasisView(CeedBasis_dict[*basis], stdout);
458d7b241e6Sjeremylt }
459d7b241e6Sjeremylt 
460d7b241e6Sjeremylt #define fCeedQRFactorization \
461d7b241e6Sjeremylt     FORTRAN_NAME(ceedqrfactorization, CEEDQRFACTORIZATION)
462a7bd39daSjeremylt void fCeedQRFactorization(int *ceed, CeedScalar *mat, CeedScalar *tau, int *m,
463a7bd39daSjeremylt                           int *n, int *err) {
464a7bd39daSjeremylt   *err = CeedQRFactorization(Ceed_dict[*ceed], mat, tau, *m, *n);
465d7b241e6Sjeremylt }
466d7b241e6Sjeremylt 
46752bfb9bbSJeremy L Thompson #define fCeedSymmetricSchurDecomposition \
46852bfb9bbSJeremy L Thompson     FORTRAN_NAME(ceedsymmetricschurdecomposition, CEEDSYMMETRICSCHURDECOMPOSITION)
46952bfb9bbSJeremy L Thompson void fCeedSymmetricSchurDecomposition(int *ceed, CeedScalar *mat,
47052bfb9bbSJeremy L Thompson                                       CeedScalar *lambda, int *n, int *err) {
47152bfb9bbSJeremy L Thompson   *err = CeedSymmetricSchurDecomposition(Ceed_dict[*ceed], mat, lambda, *n);
47252bfb9bbSJeremy L Thompson }
47352bfb9bbSJeremy L Thompson 
47452bfb9bbSJeremy L Thompson #define fCeedSimultaneousDiagonalization \
47552bfb9bbSJeremy L Thompson     FORTRAN_NAME(ceedsimultaneousdiagonalization, CEEDSIMULTANEOUSDIAGONALIZATION)
47652bfb9bbSJeremy L Thompson void fCeedSimultaneousDiagonalization(int *ceed, CeedScalar *matA,
47752bfb9bbSJeremy L Thompson                                       CeedScalar *matB, CeedScalar *x,
47852bfb9bbSJeremy L Thompson                                       CeedScalar *lambda, int *n, int *err) {
47952bfb9bbSJeremy L Thompson   *err = CeedSimultaneousDiagonalization(Ceed_dict[*ceed], matA, matB, x,
48052bfb9bbSJeremy L Thompson                                          lambda, *n);
48152bfb9bbSJeremy L Thompson }
48252bfb9bbSJeremy L Thompson 
483783c99b3SValeria Barra #define fCeedBasisGetCollocatedGrad \
484783c99b3SValeria Barra     FORTRAN_NAME(ceedbasisgetcollocatedgrad, CEEDBASISGETCOLLOCATEDGRAD)
485783c99b3SValeria Barra void fCeedBasisGetCollocatedGrad(int *basis, CeedScalar *colograd1d,
486d7b241e6Sjeremylt                                  int *err) {
487783c99b3SValeria Barra   *err = CeedBasisGetCollocatedGrad(CeedBasis_dict[*basis], colograd1d);
488d7b241e6Sjeremylt }
489d7b241e6Sjeremylt 
490d7b241e6Sjeremylt #define fCeedBasisApply FORTRAN_NAME(ceedbasisapply, CEEDBASISAPPLY)
491d7b241e6Sjeremylt void fCeedBasisApply(int *basis, int *nelem, int *tmode, int *emode,
492aedaa0e5Sjeremylt                      int *u, int *v, int *err) {
493aedaa0e5Sjeremylt   *err = CeedBasisApply(CeedBasis_dict[*basis], *nelem, *tmode, *emode,
494a7b7f929Sjeremylt                         *u==FORTRAN_VECTOR_NONE?
495a7b7f929Sjeremylt                         CEED_VECTOR_NONE:CeedVector_dict[*u],
496aedaa0e5Sjeremylt                         CeedVector_dict[*v]);
497d7b241e6Sjeremylt }
498d7b241e6Sjeremylt 
499d7b241e6Sjeremylt #define fCeedBasisGetNumNodes \
500d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasisgetnumnodes, CEEDBASISGETNUMNODES)
501d7b241e6Sjeremylt void fCeedBasisGetNumNodes(int *basis, int *P, int *err) {
502d7b241e6Sjeremylt   *err = CeedBasisGetNumNodes(CeedBasis_dict[*basis], P);
503d7b241e6Sjeremylt }
504d7b241e6Sjeremylt 
505d7b241e6Sjeremylt #define fCeedBasisGetNumQuadraturePoints \
506d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasisgetnumquadraturepoints, CEEDBASISGETNUMQUADRATUREPOINTS)
507d7b241e6Sjeremylt void fCeedBasisGetNumQuadraturePoints(int *basis, int *Q, int *err) {
508d7b241e6Sjeremylt   *err = CeedBasisGetNumQuadraturePoints(CeedBasis_dict[*basis], Q);
509d7b241e6Sjeremylt }
510d7b241e6Sjeremylt 
511d7b241e6Sjeremylt #define fCeedBasisDestroy FORTRAN_NAME(ceedbasisdestroy,CEEDBASISDESTROY)
512d7b241e6Sjeremylt void fCeedBasisDestroy(int *basis, int *err) {
513d7b241e6Sjeremylt   *err = CeedBasisDestroy(&CeedBasis_dict[*basis]);
514d7b241e6Sjeremylt 
515d7b241e6Sjeremylt   if (*err == 0) {
516d7b241e6Sjeremylt     CeedBasis_n--;
517d7b241e6Sjeremylt     if (CeedBasis_n == 0) {
518d7b241e6Sjeremylt       CeedFree(&CeedBasis_dict);
519d7b241e6Sjeremylt       CeedBasis_count = 0;
520d7b241e6Sjeremylt       CeedBasis_count_max = 0;
521d7b241e6Sjeremylt     }
522d7b241e6Sjeremylt   }
523d7b241e6Sjeremylt }
524d7b241e6Sjeremylt 
525d7b241e6Sjeremylt #define fCeedGaussQuadrature FORTRAN_NAME(ceedgaussquadrature, CEEDGAUSSQUADRATURE)
526d7b241e6Sjeremylt void fCeedGaussQuadrature(int *Q, CeedScalar *qref1d, CeedScalar *qweight1d,
527d7b241e6Sjeremylt                           int *err) {
528d7b241e6Sjeremylt   *err = CeedGaussQuadrature(*Q, qref1d, qweight1d);
529d7b241e6Sjeremylt }
530d7b241e6Sjeremylt 
531d7b241e6Sjeremylt #define fCeedLobattoQuadrature \
532d7b241e6Sjeremylt     FORTRAN_NAME(ceedlobattoquadrature, CEEDLOBATTOQUADRATURE)
533d7b241e6Sjeremylt void fCeedLobattoQuadrature(int *Q, CeedScalar *qref1d, CeedScalar *qweight1d,
534d7b241e6Sjeremylt                             int *err) {
535d7b241e6Sjeremylt   *err = CeedLobattoQuadrature(*Q, qref1d, qweight1d);
536d7b241e6Sjeremylt }
537d7b241e6Sjeremylt 
538d7b241e6Sjeremylt static CeedQFunction *CeedQFunction_dict = NULL;
539d7b241e6Sjeremylt static int CeedQFunction_count = 0;
540d7b241e6Sjeremylt static int CeedQFunction_n = 0;
541d7b241e6Sjeremylt static int CeedQFunction_count_max = 0;
542d7b241e6Sjeremylt 
543d7b241e6Sjeremylt static int CeedQFunctionFortranStub(void *ctx, int nq,
5448795c945Sjeremylt                                     const CeedScalar *const *u,
5458795c945Sjeremylt                                     CeedScalar *const *v) {
546418fb8c2Sjeremylt   fContext *fctx = ctx;
547d7b241e6Sjeremylt   int ierr;
548d7b241e6Sjeremylt 
5491e35832bSjeremylt   CeedScalar *ctx_ = (CeedScalar *) fctx->innerctx;
5501e35832bSjeremylt   fctx->f((void *)ctx_,&nq,u[0],u[1],u[2],u[3],u[4],u[5],u[6],
551418fb8c2Sjeremylt           u[7],u[8],u[9],u[10],u[11],u[12],u[13],u[14],u[15],
552418fb8c2Sjeremylt           v[0],v[1],v[2],v[3],v[4],v[5],v[6],v[7],v[8],v[9],
553418fb8c2Sjeremylt           v[10],v[11],v[12],v[13],v[14],v[15],&ierr);
554d7b241e6Sjeremylt   return ierr;
555d7b241e6Sjeremylt }
556d7b241e6Sjeremylt 
557d7b241e6Sjeremylt #define fCeedQFunctionCreateInterior \
558d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctioncreateinterior, CEEDQFUNCTIONCREATEINTERIOR)
559d7b241e6Sjeremylt void fCeedQFunctionCreateInterior(int *ceed, int *vlength,
560d7b241e6Sjeremylt                                   void (*f)(void *ctx, int *nq,
561418fb8c2Sjeremylt                                       const CeedScalar *u,const CeedScalar *u1,
562418fb8c2Sjeremylt                                       const CeedScalar *u2,const CeedScalar *u3,
563418fb8c2Sjeremylt                                       const CeedScalar *u4,const CeedScalar *u5,
564418fb8c2Sjeremylt                                       const CeedScalar *u6,const CeedScalar *u7,
565418fb8c2Sjeremylt                                       const CeedScalar *u8,const CeedScalar *u9,
566418fb8c2Sjeremylt                                       const CeedScalar *u10,const CeedScalar *u11,
567418fb8c2Sjeremylt                                       const CeedScalar *u12,const CeedScalar *u13,
568418fb8c2Sjeremylt                                       const CeedScalar *u14,const CeedScalar *u15,
569418fb8c2Sjeremylt                                       CeedScalar *v,CeedScalar *v1,CeedScalar *v2,
5708795c945Sjeremylt                                       CeedScalar *v3,CeedScalar *v4,
5718795c945Sjeremylt                                       CeedScalar *v5,CeedScalar *v6,
5728795c945Sjeremylt                                       CeedScalar *v7,CeedScalar *v8,
5738795c945Sjeremylt                                       CeedScalar *v9,CeedScalar *v10,
5748795c945Sjeremylt                                       CeedScalar *v11,CeedScalar *v12,
5758795c945Sjeremylt                                       CeedScalar *v13,CeedScalar *v14,
576418fb8c2Sjeremylt                                       CeedScalar *v15,int *err),
577288c0443SJeremy L Thompson                                   const char *source, int *qf, int *err,
578288c0443SJeremy L Thompson                                   fortran_charlen_t source_len) {
579288c0443SJeremy L Thompson   FIX_STRING(source);
580d7b241e6Sjeremylt   if (CeedQFunction_count == CeedQFunction_count_max) {
581d7b241e6Sjeremylt     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
582d7b241e6Sjeremylt     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
583d7b241e6Sjeremylt   }
584d7b241e6Sjeremylt 
585d7b241e6Sjeremylt   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
586d7b241e6Sjeremylt   *err = CeedQFunctionCreateInterior(Ceed_dict[*ceed], *vlength,
587288c0443SJeremy L Thompson                                      CeedQFunctionFortranStub, source_c, qf_);
588d7b241e6Sjeremylt 
589d7b241e6Sjeremylt   if (*err == 0) {
590d7b241e6Sjeremylt     *qf = CeedQFunction_count++;
591d7b241e6Sjeremylt     CeedQFunction_n++;
592d7b241e6Sjeremylt   }
593d7b241e6Sjeremylt 
594418fb8c2Sjeremylt   fContext *fctx;
595d7b241e6Sjeremylt   *err = CeedMalloc(1, &fctx);
596d7b241e6Sjeremylt   if (*err) return;
597418fb8c2Sjeremylt   fctx->f = f; fctx->innerctx = NULL; fctx->innerctxsize = 0;
598d7b241e6Sjeremylt 
599418fb8c2Sjeremylt   *err = CeedQFunctionSetContext(*qf_, fctx, sizeof(fContext));
600d7b241e6Sjeremylt 
601418fb8c2Sjeremylt   (*qf_)->fortranstatus = true;
602d7b241e6Sjeremylt }
603d7b241e6Sjeremylt 
604288c0443SJeremy L Thompson #define fCeedQFunctionCreateInteriorByName \
605288c0443SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncreateinteriorbyname, CEEDQFUNCTIONCREATEINTERIORBYNAME)
606288c0443SJeremy L Thompson void fCeedQFunctionCreateInteriorByName(int *ceed, const char *name, int *qf,
607288c0443SJeremy L Thompson                                         int *err, fortran_charlen_t name_len) {
608288c0443SJeremy L Thompson   FIX_STRING(name);
609288c0443SJeremy L Thompson   if (CeedQFunction_count == CeedQFunction_count_max) {
610288c0443SJeremy L Thompson     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
611288c0443SJeremy L Thompson     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
612288c0443SJeremy L Thompson   }
613288c0443SJeremy L Thompson 
614288c0443SJeremy L Thompson   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
615288c0443SJeremy L Thompson   *err = CeedQFunctionCreateInteriorByName(Ceed_dict[*ceed], name_c, qf_);
616288c0443SJeremy L Thompson 
617288c0443SJeremy L Thompson   if (*err == 0) {
618288c0443SJeremy L Thompson     *qf = CeedQFunction_count++;
619288c0443SJeremy L Thompson     CeedQFunction_n++;
620288c0443SJeremy L Thompson   }
621288c0443SJeremy L Thompson }
622288c0443SJeremy L Thompson 
6230219ea01SJeremy L Thompson #define fCeedQFunctionCreateIdentity \
6240219ea01SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncreateidentity, CEEDQFUNCTIONCREATEIDENTITY)
62560f77c51Sjeremylt void fCeedQFunctionCreateIdentity(int *ceed, int *size, int *inmode,
62660f77c51Sjeremylt                                   int *outmode, int *qf, int *err) {
6270219ea01SJeremy L Thompson   if (CeedQFunction_count == CeedQFunction_count_max) {
6280219ea01SJeremy L Thompson     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
6290219ea01SJeremy L Thompson     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
6300219ea01SJeremy L Thompson   }
6310219ea01SJeremy L Thompson 
6320219ea01SJeremy L Thompson   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
63360f77c51Sjeremylt   *err = CeedQFunctionCreateIdentity(Ceed_dict[*ceed], *size, *inmode,
63460f77c51Sjeremylt                                      *outmode, qf_);
6350219ea01SJeremy L Thompson 
6360219ea01SJeremy L Thompson   if (*err == 0) {
6370219ea01SJeremy L Thompson     *qf = CeedQFunction_count++;
6380219ea01SJeremy L Thompson     CeedQFunction_n++;
6390219ea01SJeremy L Thompson   }
6400219ea01SJeremy L Thompson }
6410219ea01SJeremy L Thompson 
642d7b241e6Sjeremylt #define fCeedQFunctionAddInput \
643d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionaddinput,CEEDQFUNCTIONADDINPUT)
644d7b241e6Sjeremylt void fCeedQFunctionAddInput(int *qf, const char *fieldname,
645c2ae719dSJed Brown                             CeedInt *ncomp, CeedEvalMode *emode, int *err,
646c2ae719dSJed Brown                             fortran_charlen_t fieldname_len) {
647c2ae719dSJed Brown   FIX_STRING(fieldname);
648d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
649d7b241e6Sjeremylt 
650c2ae719dSJed Brown   *err = CeedQFunctionAddInput(qf_, fieldname_c, *ncomp, *emode);
651d7b241e6Sjeremylt }
652d7b241e6Sjeremylt 
653d7b241e6Sjeremylt #define fCeedQFunctionAddOutput \
654d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionaddoutput,CEEDQFUNCTIONADDOUTPUT)
655d7b241e6Sjeremylt void fCeedQFunctionAddOutput(int *qf, const char *fieldname,
656c2ae719dSJed Brown                              CeedInt *ncomp, CeedEvalMode *emode, int *err,
657c2ae719dSJed Brown                              fortran_charlen_t fieldname_len) {
658c2ae719dSJed Brown   FIX_STRING(fieldname);
659d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
660d7b241e6Sjeremylt 
661c2ae719dSJed Brown   *err = CeedQFunctionAddOutput(qf_, fieldname_c, *ncomp, *emode);
662d7b241e6Sjeremylt }
663d7b241e6Sjeremylt 
664418fb8c2Sjeremylt #define fCeedQFunctionSetContext \
665418fb8c2Sjeremylt     FORTRAN_NAME(ceedqfunctionsetcontext,CEEDQFUNCTIONSETCONTEXT)
666418fb8c2Sjeremylt void fCeedQFunctionSetContext(int *qf, CeedScalar *ctx, CeedInt *n, int *err) {
667418fb8c2Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
668418fb8c2Sjeremylt 
669418fb8c2Sjeremylt   fContext *fctx = qf_->ctx;
670418fb8c2Sjeremylt   fctx->innerctx = ctx;
6711e35832bSjeremylt   fctx->innerctxsize = ((size_t) *n)*sizeof(CeedScalar);
672418fb8c2Sjeremylt }
673418fb8c2Sjeremylt 
67475affc3bSjeremylt #define fCeedQFunctionView \
67575affc3bSjeremylt     FORTRAN_NAME(ceedqfunctionview,CEEDQFUNCTIONVIEW)
67675affc3bSjeremylt void fCeedQFunctionView(int *qf, int *err) {
67775affc3bSjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
67875affc3bSjeremylt 
67975affc3bSjeremylt   *err = CeedQFunctionView(qf_, stdout);
68075affc3bSjeremylt }
68175affc3bSjeremylt 
682d7b241e6Sjeremylt #define fCeedQFunctionApply \
683d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionapply,CEEDQFUNCTIONAPPLY)
684d7b241e6Sjeremylt //TODO Need Fixing, double pointer
685d7b241e6Sjeremylt void fCeedQFunctionApply(int *qf, int *Q,
686aedaa0e5Sjeremylt                          int *u, int *u1, int *u2, int *u3,
687aedaa0e5Sjeremylt                          int *u4, int *u5, int *u6, int *u7,
688aedaa0e5Sjeremylt                          int *u8, int *u9, int *u10, int *u11,
689aedaa0e5Sjeremylt                          int *u12, int *u13, int *u14, int *u15,
690aedaa0e5Sjeremylt                          int *v, int *v1, int *v2, int *v3,
691aedaa0e5Sjeremylt                          int *v4, int *v5, int *v6, int *v7,
692aedaa0e5Sjeremylt                          int *v8, int *v9, int *v10, int *v11,
693aedaa0e5Sjeremylt                          int *v12, int *v13, int *v14, int *v15, int *err) {
694d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
695aedaa0e5Sjeremylt   CeedVector *in;
696d7b241e6Sjeremylt   *err = CeedCalloc(16, &in);
697d7b241e6Sjeremylt   if (*err) return;
698aedaa0e5Sjeremylt   in[0] = *u==FORTRAN_NULL?NULL:CeedVector_dict[*u];
699aedaa0e5Sjeremylt   in[1] = *u1==FORTRAN_NULL?NULL:CeedVector_dict[*u1];
700aedaa0e5Sjeremylt   in[2] = *u2==FORTRAN_NULL?NULL:CeedVector_dict[*u2];
701aedaa0e5Sjeremylt   in[3] = *u3==FORTRAN_NULL?NULL:CeedVector_dict[*u3];
702aedaa0e5Sjeremylt   in[4] = *u4==FORTRAN_NULL?NULL:CeedVector_dict[*u4];
703aedaa0e5Sjeremylt   in[5] = *u5==FORTRAN_NULL?NULL:CeedVector_dict[*u5];
704aedaa0e5Sjeremylt   in[6] = *u6==FORTRAN_NULL?NULL:CeedVector_dict[*u6];
705aedaa0e5Sjeremylt   in[7] = *u7==FORTRAN_NULL?NULL:CeedVector_dict[*u7];
706aedaa0e5Sjeremylt   in[8] = *u8==FORTRAN_NULL?NULL:CeedVector_dict[*u8];
707aedaa0e5Sjeremylt   in[9] = *u9==FORTRAN_NULL?NULL:CeedVector_dict[*u9];
708aedaa0e5Sjeremylt   in[10] = *u10==FORTRAN_NULL?NULL:CeedVector_dict[*u10];
709aedaa0e5Sjeremylt   in[11] = *u11==FORTRAN_NULL?NULL:CeedVector_dict[*u11];
710aedaa0e5Sjeremylt   in[12] = *u12==FORTRAN_NULL?NULL:CeedVector_dict[*u12];
711aedaa0e5Sjeremylt   in[13] = *u13==FORTRAN_NULL?NULL:CeedVector_dict[*u13];
712aedaa0e5Sjeremylt   in[14] = *u14==FORTRAN_NULL?NULL:CeedVector_dict[*u14];
713aedaa0e5Sjeremylt   in[15] = *u15==FORTRAN_NULL?NULL:CeedVector_dict[*u15];
714aedaa0e5Sjeremylt   CeedVector *out;
715d7b241e6Sjeremylt   *err = CeedCalloc(16, &out);
716d7b241e6Sjeremylt   if (*err) return;
717aedaa0e5Sjeremylt   out[0] = *v==FORTRAN_NULL?NULL:CeedVector_dict[*v];
718aedaa0e5Sjeremylt   out[1] = *v1==FORTRAN_NULL?NULL:CeedVector_dict[*v1];
719aedaa0e5Sjeremylt   out[2] = *v2==FORTRAN_NULL?NULL:CeedVector_dict[*v2];
720aedaa0e5Sjeremylt   out[3] = *v3==FORTRAN_NULL?NULL:CeedVector_dict[*v3];
721aedaa0e5Sjeremylt   out[4] = *v4==FORTRAN_NULL?NULL:CeedVector_dict[*v4];
722aedaa0e5Sjeremylt   out[5] = *v5==FORTRAN_NULL?NULL:CeedVector_dict[*v5];
723aedaa0e5Sjeremylt   out[6] = *v6==FORTRAN_NULL?NULL:CeedVector_dict[*v6];
724aedaa0e5Sjeremylt   out[7] = *v7==FORTRAN_NULL?NULL:CeedVector_dict[*v7];
725aedaa0e5Sjeremylt   out[8] = *v8==FORTRAN_NULL?NULL:CeedVector_dict[*v8];
726aedaa0e5Sjeremylt   out[9] = *v9==FORTRAN_NULL?NULL:CeedVector_dict[*v9];
727aedaa0e5Sjeremylt   out[10] = *v10==FORTRAN_NULL?NULL:CeedVector_dict[*v10];
728aedaa0e5Sjeremylt   out[11] = *v11==FORTRAN_NULL?NULL:CeedVector_dict[*v11];
729aedaa0e5Sjeremylt   out[12] = *v12==FORTRAN_NULL?NULL:CeedVector_dict[*v12];
730aedaa0e5Sjeremylt   out[13] = *v13==FORTRAN_NULL?NULL:CeedVector_dict[*v13];
731aedaa0e5Sjeremylt   out[14] = *v14==FORTRAN_NULL?NULL:CeedVector_dict[*v14];
732aedaa0e5Sjeremylt   out[15] = *v15==FORTRAN_NULL?NULL:CeedVector_dict[*v15];
733aedaa0e5Sjeremylt   *err = CeedQFunctionApply(qf_, *Q, in, out);
734d7b241e6Sjeremylt   if (*err) return;
735d7b241e6Sjeremylt 
736d7b241e6Sjeremylt   *err = CeedFree(&in);
737d7b241e6Sjeremylt   if (*err) return;
738d7b241e6Sjeremylt   *err = CeedFree(&out);
739d7b241e6Sjeremylt }
740d7b241e6Sjeremylt 
741d7b241e6Sjeremylt #define fCeedQFunctionDestroy \
742d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctiondestroy,CEEDQFUNCTIONDESTROY)
743d7b241e6Sjeremylt void fCeedQFunctionDestroy(int *qf, int *err) {
7441134a487Sjeremylt   bool fstatus;
7451134a487Sjeremylt   *err = CeedQFunctionGetFortranStatus(CeedQFunction_dict[*qf], &fstatus);
7461134a487Sjeremylt   if (*err) return;
7471134a487Sjeremylt   if (fstatus) {
748c4b814baSjeremylt     fContext *fctx = CeedQFunction_dict[*qf]->ctx;
749c4b814baSjeremylt     *err = CeedFree(&fctx);
750d7b241e6Sjeremylt     if (*err) return;
7511134a487Sjeremylt   }
752c4b814baSjeremylt 
753c4b814baSjeremylt   *err = CeedQFunctionDestroy(&CeedQFunction_dict[*qf]);
754c4b814baSjeremylt   if (*err) return;
755c4b814baSjeremylt 
756d7b241e6Sjeremylt   CeedQFunction_n--;
757d7b241e6Sjeremylt   if (CeedQFunction_n == 0) {
758d7b241e6Sjeremylt     *err = CeedFree(&CeedQFunction_dict);
759d7b241e6Sjeremylt     CeedQFunction_count = 0;
760d7b241e6Sjeremylt     CeedQFunction_count_max = 0;
761d7b241e6Sjeremylt   }
762d7b241e6Sjeremylt }
763d7b241e6Sjeremylt 
764d7b241e6Sjeremylt static CeedOperator *CeedOperator_dict = NULL;
765d7b241e6Sjeremylt static int CeedOperator_count = 0;
766d7b241e6Sjeremylt static int CeedOperator_n = 0;
767d7b241e6Sjeremylt static int CeedOperator_count_max = 0;
768d7b241e6Sjeremylt 
769d7b241e6Sjeremylt #define fCeedOperatorCreate \
770d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorcreate, CEEDOPERATORCREATE)
771d7b241e6Sjeremylt void fCeedOperatorCreate(int *ceed,
772d7b241e6Sjeremylt                          int *qf, int *dqf, int *dqfT, int *op, int *err) {
773d7b241e6Sjeremylt   if (CeedOperator_count == CeedOperator_count_max)
774d7b241e6Sjeremylt     CeedOperator_count_max += CeedOperator_count_max/2 + 1,
7758795c945Sjeremylt                               CeedOperator_dict = realloc(CeedOperator_dict,
7768795c945Sjeremylt                                   sizeof(CeedOperator)*CeedOperator_count_max);
777d7b241e6Sjeremylt 
778d7b241e6Sjeremylt   CeedOperator *op_ = &CeedOperator_dict[CeedOperator_count];
779d7b241e6Sjeremylt 
780442e7f0bSjeremylt   CeedQFunction dqf_  = CEED_QFUNCTION_NONE, dqfT_ = CEED_QFUNCTION_NONE;
781442e7f0bSjeremylt   if (*dqf  != FORTRAN_QFUNCTION_NONE) dqf_  = CeedQFunction_dict[*dqf ];
782442e7f0bSjeremylt   if (*dqfT != FORTRAN_QFUNCTION_NONE) dqfT_ = CeedQFunction_dict[*dqfT];
783d7b241e6Sjeremylt 
784d7b241e6Sjeremylt   *err = CeedOperatorCreate(Ceed_dict[*ceed], CeedQFunction_dict[*qf], dqf_,
785d7b241e6Sjeremylt                             dqfT_, op_);
786d7b241e6Sjeremylt   if (*err) return;
787d7b241e6Sjeremylt   *op = CeedOperator_count++;
788d7b241e6Sjeremylt   CeedOperator_n++;
789d7b241e6Sjeremylt }
790d7b241e6Sjeremylt 
79152d6035fSJeremy L Thompson #define fCeedCompositeOperatorCreate \
79252d6035fSJeremy L Thompson     FORTRAN_NAME(ceedcompositeoperatorcreate, CEEDCOMPOSITEOPERATORCREATE)
79352d6035fSJeremy L Thompson void fCeedCompositeOperatorCreate(int *ceed, int *op, int *err) {
79452d6035fSJeremy L Thompson   if (CeedOperator_count == CeedOperator_count_max)
79552d6035fSJeremy L Thompson     CeedOperator_count_max += CeedOperator_count_max/2 + 1,
7968795c945Sjeremylt                               CeedOperator_dict = realloc(CeedOperator_dict,
7978795c945Sjeremylt                                   sizeof(CeedOperator)*CeedOperator_count_max);
79852d6035fSJeremy L Thompson 
79952d6035fSJeremy L Thompson   CeedOperator *op_ = &CeedOperator_dict[CeedOperator_count];
80052d6035fSJeremy L Thompson 
80152d6035fSJeremy L Thompson   *err = CeedCompositeOperatorCreate(Ceed_dict[*ceed], op_);
80252d6035fSJeremy L Thompson   if (*err) return;
80352d6035fSJeremy L Thompson   *op = CeedOperator_count++;
80452d6035fSJeremy L Thompson   CeedOperator_n++;
80552d6035fSJeremy L Thompson }
80652d6035fSJeremy L Thompson 
807d7b241e6Sjeremylt #define fCeedOperatorSetField \
808d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorsetfield,CEEDOPERATORSETFIELD)
809*a8d32208Sjeremylt void fCeedOperatorSetField(int *op, const char *fieldname, int *r, int *b,
810*a8d32208Sjeremylt                            int *v, int *err, fortran_charlen_t fieldname_len) {
811c2ae719dSJed Brown   FIX_STRING(fieldname);
812d7b241e6Sjeremylt   CeedElemRestriction r_;
813d7b241e6Sjeremylt   CeedBasis b_;
814d7b241e6Sjeremylt   CeedVector v_;
815d7b241e6Sjeremylt 
816d7b241e6Sjeremylt   CeedOperator op_ = CeedOperator_dict[*op];
817d7b241e6Sjeremylt 
818d7b241e6Sjeremylt   if (*r == FORTRAN_NULL) {
819d7b241e6Sjeremylt     r_ = NULL;
820d7b241e6Sjeremylt   } else {
821d7b241e6Sjeremylt     r_ = CeedElemRestriction_dict[*r];
822d7b241e6Sjeremylt   }
8234dccadb6Sjeremylt 
824d7b241e6Sjeremylt   if (*b == FORTRAN_NULL) {
825d7b241e6Sjeremylt     b_ = NULL;
826783c99b3SValeria Barra   } else if (*b == FORTRAN_BASIS_COLLOCATED) {
827783c99b3SValeria Barra     b_ = CEED_BASIS_COLLOCATED;
828d7b241e6Sjeremylt   } else {
829d7b241e6Sjeremylt     b_ = CeedBasis_dict[*b];
830d7b241e6Sjeremylt   }
831d7b241e6Sjeremylt   if (*v == FORTRAN_NULL) {
832d7b241e6Sjeremylt     v_ = NULL;
833d7b241e6Sjeremylt   } else if (*v == FORTRAN_VECTOR_ACTIVE) {
834d7b241e6Sjeremylt     v_ = CEED_VECTOR_ACTIVE;
835d7b241e6Sjeremylt   } else if (*v == FORTRAN_VECTOR_NONE) {
836d7b241e6Sjeremylt     v_ = CEED_VECTOR_NONE;
837d7b241e6Sjeremylt   } else {
838d7b241e6Sjeremylt     v_ = CeedVector_dict[*v];
839d7b241e6Sjeremylt   }
840d7b241e6Sjeremylt 
841*a8d32208Sjeremylt   *err = CeedOperatorSetField(op_, fieldname_c, r_, b_, v_);
842d7b241e6Sjeremylt }
843d7b241e6Sjeremylt 
84452d6035fSJeremy L Thompson #define fCeedCompositeOperatorAddSub \
84552d6035fSJeremy L Thompson     FORTRAN_NAME(ceedcompositeoperatoraddsub, CEEDCOMPOSITEOPERATORADDSUB)
84652d6035fSJeremy L Thompson void fCeedCompositeOperatorAddSub(int *compositeop, int *subop, int *err) {
84752d6035fSJeremy L Thompson   CeedOperator compositeop_ = CeedOperator_dict[*compositeop];
84852d6035fSJeremy L Thompson   CeedOperator subop_ = CeedOperator_dict[*subop];
84952d6035fSJeremy L Thompson 
85052d6035fSJeremy L Thompson   *err = CeedCompositeOperatorAddSub(compositeop_, subop_);
85152d6035fSJeremy L Thompson   if (*err) return;
85252d6035fSJeremy L Thompson }
85352d6035fSJeremy L Thompson 
8541d102b48SJeremy L Thompson #define fCeedOperatorAssembleLinearQFunction FORTRAN_NAME(ceedoperatorassemblelinearqfunction, CEEDOPERATORASSEMBLELINEARQFUNCTION)
8551d102b48SJeremy L Thompson void fCeedOperatorAssembleLinearQFunction(int *op, int *assembledvec,
8561d102b48SJeremy L Thompson     int *assembledrstr, int *rqst, int *err) {
8571d102b48SJeremy L Thompson   // Vector
8581d102b48SJeremy L Thompson   if (CeedVector_count == CeedVector_count_max) {
8591d102b48SJeremy L Thompson     CeedVector_count_max += CeedVector_count_max/2 + 1;
8601d102b48SJeremy L Thompson     CeedRealloc(CeedVector_count_max, &CeedVector_dict);
8611d102b48SJeremy L Thompson   }
8621d102b48SJeremy L Thompson   CeedVector *assembledvec_ = &CeedVector_dict[CeedVector_count];
8631d102b48SJeremy L Thompson 
8641d102b48SJeremy L Thompson   // Restriction
8651d102b48SJeremy L Thompson   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
8661d102b48SJeremy L Thompson     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
8671d102b48SJeremy L Thompson     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
8681d102b48SJeremy L Thompson   }
8691d102b48SJeremy L Thompson   CeedElemRestriction *rstr_ =
8701d102b48SJeremy L Thompson     &CeedElemRestriction_dict[CeedElemRestriction_count];
8711d102b48SJeremy L Thompson 
8721d102b48SJeremy L Thompson   int createRequest = 1;
8731d102b48SJeremy L Thompson   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
8741d102b48SJeremy L Thompson   if (*rqst == -1 || *rqst == -2) {
8751d102b48SJeremy L Thompson     createRequest = 0;
8761d102b48SJeremy L Thompson   }
8771d102b48SJeremy L Thompson 
8781d102b48SJeremy L Thompson   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
8791d102b48SJeremy L Thompson     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
8801d102b48SJeremy L Thompson     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
8811d102b48SJeremy L Thompson   }
8821d102b48SJeremy L Thompson 
8831d102b48SJeremy L Thompson   CeedRequest *rqst_;
8841d102b48SJeremy L Thompson   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
8851d102b48SJeremy L Thompson   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
8861d102b48SJeremy L Thompson   else rqst_ = &CeedRequest_dict[CeedRequest_count];
8871d102b48SJeremy L Thompson 
8881d102b48SJeremy L Thompson   *err = CeedOperatorAssembleLinearQFunction(CeedOperator_dict[*op],
8891d102b48SJeremy L Thompson          assembledvec_, rstr_, rqst_);
8901d102b48SJeremy L Thompson   if (*err) return;
8911d102b48SJeremy L Thompson   if (createRequest) {
8921d102b48SJeremy L Thompson     *rqst = CeedRequest_count++;
8931d102b48SJeremy L Thompson     CeedRequest_n++;
8941d102b48SJeremy L Thompson   }
8951d102b48SJeremy L Thompson 
8961d102b48SJeremy L Thompson   if (*err == 0) {
8971d102b48SJeremy L Thompson     *assembledrstr = CeedElemRestriction_count++;
8981d102b48SJeremy L Thompson     CeedElemRestriction_n++;
8991d102b48SJeremy L Thompson     *assembledvec = CeedVector_count++;
9001d102b48SJeremy L Thompson     CeedVector_n++;
9011d102b48SJeremy L Thompson   }
9021d102b48SJeremy L Thompson }
9031d102b48SJeremy L Thompson 
904b7ec98d8SJeremy L Thompson #define fCeedOperatorAssembleLinearDiagonal FORTRAN_NAME(ceedoperatorassemblelineardiagonal, CEEDOPERATORASSEMBLELINEARDIAGONAL)
905b7ec98d8SJeremy L Thompson void fCeedOperatorAssembleLinearDiagonal(int *op, int *assembledvec,
906b7ec98d8SJeremy L Thompson     int *rqst, int *err) {
907b7ec98d8SJeremy L Thompson   // Vector
908b7ec98d8SJeremy L Thompson   if (CeedVector_count == CeedVector_count_max) {
909b7ec98d8SJeremy L Thompson     CeedVector_count_max += CeedVector_count_max/2 + 1;
910b7ec98d8SJeremy L Thompson     CeedRealloc(CeedVector_count_max, &CeedVector_dict);
911b7ec98d8SJeremy L Thompson   }
912b7ec98d8SJeremy L Thompson   CeedVector *assembledvec_ = &CeedVector_dict[CeedVector_count];
913b7ec98d8SJeremy L Thompson 
914b7ec98d8SJeremy L Thompson   int createRequest = 1;
915b7ec98d8SJeremy L Thompson   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
916b7ec98d8SJeremy L Thompson   if (*rqst == -1 || *rqst == -2) {
917b7ec98d8SJeremy L Thompson     createRequest = 0;
918b7ec98d8SJeremy L Thompson   }
919b7ec98d8SJeremy L Thompson 
920b7ec98d8SJeremy L Thompson   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
921b7ec98d8SJeremy L Thompson     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
922b7ec98d8SJeremy L Thompson     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
923b7ec98d8SJeremy L Thompson   }
924b7ec98d8SJeremy L Thompson 
925b7ec98d8SJeremy L Thompson   CeedRequest *rqst_;
926b7ec98d8SJeremy L Thompson   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
927b7ec98d8SJeremy L Thompson   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
928b7ec98d8SJeremy L Thompson   else rqst_ = &CeedRequest_dict[CeedRequest_count];
929b7ec98d8SJeremy L Thompson 
930b7ec98d8SJeremy L Thompson   *err = CeedOperatorAssembleLinearDiagonal(CeedOperator_dict[*op],
931b7ec98d8SJeremy L Thompson          assembledvec_, rqst_);
932b7ec98d8SJeremy L Thompson   if (*err) return;
933b7ec98d8SJeremy L Thompson   if (createRequest) {
934b7ec98d8SJeremy L Thompson     *rqst = CeedRequest_count++;
935b7ec98d8SJeremy L Thompson     CeedRequest_n++;
936b7ec98d8SJeremy L Thompson   }
937b7ec98d8SJeremy L Thompson 
938b7ec98d8SJeremy L Thompson   if (*err == 0) {
939b7ec98d8SJeremy L Thompson     *assembledvec = CeedVector_count++;
940b7ec98d8SJeremy L Thompson     CeedVector_n++;
941b7ec98d8SJeremy L Thompson   }
942b7ec98d8SJeremy L Thompson }
943b7ec98d8SJeremy L Thompson 
9442ebaca42Sjeremylt #define fCeedOperatorView \
9452ebaca42Sjeremylt     FORTRAN_NAME(ceedoperatorview,CEEDOPERATORVIEW)
9462ebaca42Sjeremylt void fCeedOperatorView(int *op, int *err) {
9472ebaca42Sjeremylt   CeedOperator op_ = CeedOperator_dict[*op];
9482ebaca42Sjeremylt 
9492ebaca42Sjeremylt   *err = CeedOperatorView(op_, stdout);
9502ebaca42Sjeremylt }
9512ebaca42Sjeremylt 
9523bd813ffSjeremylt #define fCeedOperatorCreateFDMElementInverse FORTRAN_NAME(ceedoperatorcreatefdmelementinverse, CEEDOPERATORCREATEFDMELEMENTINVERSE)
9533bd813ffSjeremylt void fCeedOperatorCreateFDMElementInverse(int *op, int *fdminv,
9543bd813ffSjeremylt     int *rqst, int *err) {
9553bd813ffSjeremylt   // Operator
9563bd813ffSjeremylt   if (CeedOperator_count == CeedOperator_count_max) {
9573bd813ffSjeremylt     CeedOperator_count_max += CeedOperator_count_max/2 + 1;
9583bd813ffSjeremylt     CeedRealloc(CeedOperator_count_max, &CeedOperator_dict);
9593bd813ffSjeremylt   }
9603bd813ffSjeremylt   CeedOperator *fdminv_ =
9613bd813ffSjeremylt     &CeedOperator_dict[CeedOperator_count];
9623bd813ffSjeremylt 
9633bd813ffSjeremylt   int createRequest = 1;
9643bd813ffSjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
9653bd813ffSjeremylt   if (*rqst == -1 || *rqst == -2) {
9663bd813ffSjeremylt     createRequest = 0;
9673bd813ffSjeremylt   }
9683bd813ffSjeremylt 
9693bd813ffSjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
9703bd813ffSjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
9713bd813ffSjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
9723bd813ffSjeremylt   }
9733bd813ffSjeremylt 
9743bd813ffSjeremylt   CeedRequest *rqst_;
9753bd813ffSjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
9763bd813ffSjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
9773bd813ffSjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
9783bd813ffSjeremylt 
9793bd813ffSjeremylt   *err = CeedOperatorCreateFDMElementInverse(CeedOperator_dict[*op],
9803bd813ffSjeremylt          fdminv_, rqst_);
9813bd813ffSjeremylt   if (*err) return;
9823bd813ffSjeremylt   if (createRequest) {
9833bd813ffSjeremylt     *rqst = CeedRequest_count++;
9843bd813ffSjeremylt     CeedRequest_n++;
9853bd813ffSjeremylt   }
9863bd813ffSjeremylt 
9873bd813ffSjeremylt   if (*err == 0) {
9883bd813ffSjeremylt     *fdminv = CeedOperator_count++;
9893bd813ffSjeremylt     CeedOperator_n++;
9903bd813ffSjeremylt   }
9913bd813ffSjeremylt }
9923bd813ffSjeremylt 
993d7b241e6Sjeremylt #define fCeedOperatorApply FORTRAN_NAME(ceedoperatorapply, CEEDOPERATORAPPLY)
994d7b241e6Sjeremylt void fCeedOperatorApply(int *op, int *ustatevec,
995d7b241e6Sjeremylt                         int *resvec, int *rqst, int *err) {
996e97ff134Sjeremylt   CeedVector ustatevec_ = (*ustatevec == FORTRAN_NULL) ?
997e97ff134Sjeremylt                           NULL : (*ustatevec == FORTRAN_VECTOR_NONE ?
998e97ff134Sjeremylt                                   CEED_VECTOR_NONE : CeedVector_dict[*ustatevec]);
999e97ff134Sjeremylt   CeedVector resvec_ = (*resvec == FORTRAN_NULL) ?
1000e97ff134Sjeremylt                        NULL : (*resvec == FORTRAN_VECTOR_NONE ?
1001e97ff134Sjeremylt                                CEED_VECTOR_NONE : CeedVector_dict[*resvec]);
1002d7b241e6Sjeremylt 
1003d7b241e6Sjeremylt   int createRequest = 1;
1004d7b241e6Sjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
1005d7b241e6Sjeremylt   if (*rqst == -1 || *rqst == -2) {
1006d7b241e6Sjeremylt     createRequest = 0;
1007d7b241e6Sjeremylt   }
1008d7b241e6Sjeremylt 
1009d7b241e6Sjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
1010d7b241e6Sjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
1011d7b241e6Sjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
1012d7b241e6Sjeremylt   }
1013d7b241e6Sjeremylt 
1014d7b241e6Sjeremylt   CeedRequest *rqst_;
1015d7b241e6Sjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
1016d7b241e6Sjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
1017d7b241e6Sjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
1018d7b241e6Sjeremylt 
1019d7b241e6Sjeremylt   *err = CeedOperatorApply(CeedOperator_dict[*op],
102012bf2c11SJed Brown                            ustatevec_, resvec_, rqst_);
1021d7b241e6Sjeremylt   if (*err) return;
1022d7b241e6Sjeremylt   if (createRequest) {
1023d7b241e6Sjeremylt     *rqst = CeedRequest_count++;
1024d7b241e6Sjeremylt     CeedRequest_n++;
1025d7b241e6Sjeremylt   }
1026d7b241e6Sjeremylt }
1027d7b241e6Sjeremylt 
1028cae8b89aSjeremylt #define fCeedOperatorApplyAdd FORTRAN_NAME(ceedoperatorapplyadd, CEEDOPERATORAPPLYADD)
1029cae8b89aSjeremylt void fCeedOperatorApplyAdd(int *op, int *ustatevec,
1030cae8b89aSjeremylt                            int *resvec, int *rqst, int *err) {
1031cae8b89aSjeremylt   CeedVector ustatevec_ = *ustatevec == FORTRAN_NULL
1032cae8b89aSjeremylt                           ? NULL : CeedVector_dict[*ustatevec];
1033cae8b89aSjeremylt   CeedVector resvec_ = *resvec == FORTRAN_NULL
1034cae8b89aSjeremylt                        ? NULL : CeedVector_dict[*resvec];
1035cae8b89aSjeremylt 
1036cae8b89aSjeremylt   int createRequest = 1;
1037cae8b89aSjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
1038cae8b89aSjeremylt   if (*rqst == -1 || *rqst == -2) {
1039cae8b89aSjeremylt     createRequest = 0;
1040cae8b89aSjeremylt   }
1041cae8b89aSjeremylt 
1042cae8b89aSjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
1043cae8b89aSjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
1044cae8b89aSjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
1045cae8b89aSjeremylt   }
1046cae8b89aSjeremylt 
1047cae8b89aSjeremylt   CeedRequest *rqst_;
1048cae8b89aSjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
1049cae8b89aSjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
1050cae8b89aSjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
1051cae8b89aSjeremylt 
1052cae8b89aSjeremylt   *err = CeedOperatorApplyAdd(CeedOperator_dict[*op],
1053cae8b89aSjeremylt                               ustatevec_, resvec_, rqst_);
1054cae8b89aSjeremylt   if (*err) return;
1055cae8b89aSjeremylt   if (createRequest) {
1056cae8b89aSjeremylt     *rqst = CeedRequest_count++;
1057cae8b89aSjeremylt     CeedRequest_n++;
1058cae8b89aSjeremylt   }
1059cae8b89aSjeremylt }
1060cae8b89aSjeremylt 
1061d7b241e6Sjeremylt #define fCeedOperatorApplyJacobian \
1062d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorapplyjacobian, CEEDOPERATORAPPLYJACOBIAN)
1063d7b241e6Sjeremylt void fCeedOperatorApplyJacobian(int *op, int *qdatavec, int *ustatevec,
10648795c945Sjeremylt                                 int *dustatevec, int *dresvec, int *rqst,
10658795c945Sjeremylt                                 int *err) {
1066d7b241e6Sjeremylt // TODO Uncomment this when CeedOperatorApplyJacobian is implemented
1067d7b241e6Sjeremylt //  *err = CeedOperatorApplyJacobian(CeedOperator_dict[*op], CeedVector_dict[*qdatavec],
1068d7b241e6Sjeremylt //             CeedVector_dict[*ustatevec], CeedVector_dict[*dustatevec],
1069d7b241e6Sjeremylt //             CeedVector_dict[*dresvec], &CeedRequest_dict[*rqst]);
1070d7b241e6Sjeremylt }
1071d7b241e6Sjeremylt 
1072d7b241e6Sjeremylt #define fCeedOperatorDestroy \
1073d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatordestroy, CEEDOPERATORDESTROY)
1074d7b241e6Sjeremylt void fCeedOperatorDestroy(int *op, int *err) {
1075d7b241e6Sjeremylt   *err = CeedOperatorDestroy(&CeedOperator_dict[*op]);
1076d7b241e6Sjeremylt   if (*err) return;
1077d7b241e6Sjeremylt   CeedOperator_n--;
1078d7b241e6Sjeremylt   if (CeedOperator_n == 0) {
1079d7b241e6Sjeremylt     *err = CeedFree(&CeedOperator_dict);
1080d7b241e6Sjeremylt     CeedOperator_count = 0;
1081d7b241e6Sjeremylt     CeedOperator_count_max = 0;
1082d7b241e6Sjeremylt   }
1083d7b241e6Sjeremylt }
1084