xref: /libCEED/rust/libceed-sys/c-src/interface/ceed-fortran.c (revision 547d9b97859fb07c9c2b832a30615e0bf91eaab3)
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 
178*547d9b97Sjeremylt #define fCeedVectorNorm \
179*547d9b97Sjeremylt     FORTRAN_NAME(ceedvectornorm,CEEDVECTORNORM)
180*547d9b97Sjeremylt void fCeedVectorNorm(int *vec, int *type, CeedScalar *norm, int *err) {
181*547d9b97Sjeremylt   *err = CeedVectorNorm(CeedVector_dict[*vec], *type, norm);
182*547d9b97Sjeremylt }
183*547d9b97Sjeremylt 
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)
210d7b241e6Sjeremylt void fCeedElemRestrictionCreate(int *ceed, 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];
2238795c945Sjeremylt   *err = CeedElemRestrictionCreate(Ceed_dict[*ceed], *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)
235d7b241e6Sjeremylt void fCeedElemRestrictionCreateIdentity(int *ceed, 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];
2454b8bea3bSJed Brown   *err = CeedElemRestrictionCreateIdentity(Ceed_dict[*ceed], *nelements, *esize,
2468795c945Sjeremylt          *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)
256d7b241e6Sjeremylt void fCeedElemRestrictionCreateBlocked(int *ceed, 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];
269d7b241e6Sjeremylt   *err = CeedElemRestrictionCreateBlocked(Ceed_dict[*ceed], *nelements, *esize,
2708795c945Sjeremylt                                           *blocksize, *nnodes, *ncomp, *mtype,
2718795c945Sjeremylt                                           *cmode, blkindices, elemrestriction_);
272d7b241e6Sjeremylt 
273d7b241e6Sjeremylt   if (*err == 0) {
274d7b241e6Sjeremylt     *elemrestriction = CeedElemRestriction_count++;
275d7b241e6Sjeremylt     CeedElemRestriction_n++;
276d7b241e6Sjeremylt   }
277d7b241e6Sjeremylt }
278d7b241e6Sjeremylt 
279d7b241e6Sjeremylt static CeedRequest *CeedRequest_dict = NULL;
280d7b241e6Sjeremylt static int CeedRequest_count = 0;
281d7b241e6Sjeremylt static int CeedRequest_n = 0;
282d7b241e6Sjeremylt static int CeedRequest_count_max = 0;
283d7b241e6Sjeremylt 
284d7b241e6Sjeremylt #define fCeedElemRestrictionApply \
285d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictionapply,CEEDELEMRESTRICTIONAPPLY)
286d7b241e6Sjeremylt void fCeedElemRestrictionApply(int *elemr, int *tmode, int *lmode,
287d7b241e6Sjeremylt                                int *uvec, int *ruvec, int *rqst, int *err) {
288d7b241e6Sjeremylt   int createRequest = 1;
289d7b241e6Sjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
290d7b241e6Sjeremylt   if (*rqst == FORTRAN_REQUEST_IMMEDIATE || *rqst == FORTRAN_REQUEST_ORDERED)
291d7b241e6Sjeremylt     createRequest = 0;
292d7b241e6Sjeremylt 
293d7b241e6Sjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
294d7b241e6Sjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
295d7b241e6Sjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
296d7b241e6Sjeremylt   }
297d7b241e6Sjeremylt 
298d7b241e6Sjeremylt   CeedRequest *rqst_;
299d7b241e6Sjeremylt   if      (*rqst == FORTRAN_REQUEST_IMMEDIATE) rqst_ = CEED_REQUEST_IMMEDIATE;
300d7b241e6Sjeremylt   else if (*rqst == FORTRAN_REQUEST_ORDERED  ) rqst_ = CEED_REQUEST_ORDERED;
301d7b241e6Sjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
302d7b241e6Sjeremylt 
303d7b241e6Sjeremylt   *err = CeedElemRestrictionApply(CeedElemRestriction_dict[*elemr], *tmode,
3048795c945Sjeremylt                                   *lmode, CeedVector_dict[*uvec],
3058795c945Sjeremylt                                   CeedVector_dict[*ruvec], rqst_);
306d7b241e6Sjeremylt 
307d7b241e6Sjeremylt   if (*err == 0 && createRequest) {
308d7b241e6Sjeremylt     *rqst = CeedRequest_count++;
309d7b241e6Sjeremylt     CeedRequest_n++;
310d7b241e6Sjeremylt   }
311d7b241e6Sjeremylt }
312d7b241e6Sjeremylt 
313be9261b7Sjeremylt #define fCeedElemRestrictionApplyBlock \
314be9261b7Sjeremylt     FORTRAN_NAME(ceedelemrestrictionapplyblock,CEEDELEMRESTRICTIONAPPLYBLOCK)
315f90c8643Sjeremylt void fCeedElemRestrictionApplyBlock(int *elemr, int *block, int *tmode,
316f90c8643Sjeremylt                                     int *lmode,
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,
334be9261b7Sjeremylt                                        *tmode, *lmode, 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)
345efc78312Sjeremylt void fCeedElemRestrictionGetMultiplicity(int *elemr, int *lmode, int *mult,
346efc78312Sjeremylt     int *err) {
3471469ee4dSjeremylt   *err = CeedElemRestrictionGetMultiplicity(CeedElemRestriction_dict[*elemr],
348efc78312Sjeremylt          *lmode, CeedVector_dict[*mult]);
3491469ee4dSjeremylt }
3501469ee4dSjeremylt 
3515a86f033Sjeremylt #define fCeedElemRestrictionView \
3525a86f033Sjeremylt     FORTRAN_NAME(ceedelemrestrictionview,CEEDELEMRESTRICTIONVIEW)
3535a86f033Sjeremylt void fCeedElemRestrictionView(int *elemr, int *err) {
3545a86f033Sjeremylt   *err = CeedElemRestrictionView(CeedElemRestriction_dict[*elemr], stdout);
3555a86f033Sjeremylt }
3561469ee4dSjeremylt 
357d7b241e6Sjeremylt #define fCeedRequestWait FORTRAN_NAME(ceedrequestwait, CEEDREQUESTWAIT)
358d7b241e6Sjeremylt void fCeedRequestWait(int *rqst, int *err) {
359d7b241e6Sjeremylt   // TODO Uncomment this once CeedRequestWait is implemented
360d7b241e6Sjeremylt   //*err = CeedRequestWait(&CeedRequest_dict[*rqst]);
361d7b241e6Sjeremylt 
362d7b241e6Sjeremylt   if (*err == 0) {
363d7b241e6Sjeremylt     CeedRequest_n--;
364d7b241e6Sjeremylt     if (CeedRequest_n == 0) {
365d7b241e6Sjeremylt       CeedFree(&CeedRequest_dict);
366d7b241e6Sjeremylt       CeedRequest_count = 0;
367d7b241e6Sjeremylt       CeedRequest_count_max = 0;
368d7b241e6Sjeremylt     }
369d7b241e6Sjeremylt   }
370d7b241e6Sjeremylt }
371d7b241e6Sjeremylt 
372d7b241e6Sjeremylt #define fCeedElemRestrictionDestroy \
373d7b241e6Sjeremylt     FORTRAN_NAME(ceedelemrestrictiondestroy,CEEDELEMRESTRICTIONDESTROY)
374d7b241e6Sjeremylt void fCeedElemRestrictionDestroy(int *elem, int *err) {
375d7b241e6Sjeremylt   *err = CeedElemRestrictionDestroy(&CeedElemRestriction_dict[*elem]);
376d7b241e6Sjeremylt 
377d7b241e6Sjeremylt   if (*err == 0) {
378d7b241e6Sjeremylt     CeedElemRestriction_n--;
379d7b241e6Sjeremylt     if (CeedElemRestriction_n == 0) {
380d7b241e6Sjeremylt       CeedFree(&CeedElemRestriction_dict);
381d7b241e6Sjeremylt       CeedElemRestriction_count = 0;
382d7b241e6Sjeremylt       CeedElemRestriction_count_max = 0;
383d7b241e6Sjeremylt     }
384d7b241e6Sjeremylt   }
385d7b241e6Sjeremylt }
386d7b241e6Sjeremylt 
387d7b241e6Sjeremylt static CeedBasis *CeedBasis_dict = NULL;
388d7b241e6Sjeremylt static int CeedBasis_count = 0;
389d7b241e6Sjeremylt static int CeedBasis_n = 0;
390d7b241e6Sjeremylt static int CeedBasis_count_max = 0;
391d7b241e6Sjeremylt 
392d7b241e6Sjeremylt #define fCeedBasisCreateTensorH1Lagrange \
393d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasiscreatetensorh1lagrange, CEEDBASISCREATETENSORH1LAGRANGE)
394d7b241e6Sjeremylt void fCeedBasisCreateTensorH1Lagrange(int *ceed, int *dim,
3958795c945Sjeremylt                                       int *ncomp, int *P, int *Q, int *quadmode,
3968795c945Sjeremylt                                       int *basis, int *err) {
397d7b241e6Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
398d7b241e6Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
399d7b241e6Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
400d7b241e6Sjeremylt   }
401d7b241e6Sjeremylt 
402a8de75f0Sjeremylt   *err = CeedBasisCreateTensorH1Lagrange(Ceed_dict[*ceed], *dim, *ncomp, *P, *Q,
4038795c945Sjeremylt                                          *quadmode,
4048795c945Sjeremylt                                          &CeedBasis_dict[CeedBasis_count]);
405d7b241e6Sjeremylt 
406d7b241e6Sjeremylt   if (*err == 0) {
407d7b241e6Sjeremylt     *basis = CeedBasis_count++;
408d7b241e6Sjeremylt     CeedBasis_n++;
409d7b241e6Sjeremylt   }
410d7b241e6Sjeremylt }
411d7b241e6Sjeremylt 
412d7b241e6Sjeremylt #define fCeedBasisCreateTensorH1 \
413d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasiscreatetensorh1, CEEDBASISCREATETENSORH1)
414a8de75f0Sjeremylt void fCeedBasisCreateTensorH1(int *ceed, int *dim, int *ncomp, int *P1d,
4158795c945Sjeremylt                               int *Q1d, const CeedScalar *interp1d,
4168795c945Sjeremylt                               const CeedScalar *grad1d,
4178795c945Sjeremylt                               const CeedScalar *qref1d,
4188795c945Sjeremylt                               const CeedScalar *qweight1d, int *basis,
4198795c945Sjeremylt                               int *err) {
420d7b241e6Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
421d7b241e6Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
422d7b241e6Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
423d7b241e6Sjeremylt   }
424d7b241e6Sjeremylt 
425a8de75f0Sjeremylt   *err = CeedBasisCreateTensorH1(Ceed_dict[*ceed], *dim, *ncomp, *P1d, *Q1d,
4268795c945Sjeremylt                                  interp1d, grad1d, qref1d, qweight1d,
4278795c945Sjeremylt                                  &CeedBasis_dict[CeedBasis_count]);
428d7b241e6Sjeremylt 
429d7b241e6Sjeremylt   if (*err == 0) {
430d7b241e6Sjeremylt     *basis = CeedBasis_count++;
431d7b241e6Sjeremylt     CeedBasis_n++;
432d7b241e6Sjeremylt   }
433d7b241e6Sjeremylt }
434d7b241e6Sjeremylt 
435a8de75f0Sjeremylt #define fCeedBasisCreateH1 \
436a8de75f0Sjeremylt     FORTRAN_NAME(ceedbasiscreateh1, CEEDBASISCREATEH1)
4378795c945Sjeremylt void fCeedBasisCreateH1(int *ceed, int *topo, int *ncomp, int *nnodes,
4388795c945Sjeremylt                         int *nqpts, const CeedScalar *interp,
4398795c945Sjeremylt                         const CeedScalar *grad, const CeedScalar *qref,
4408795c945Sjeremylt                         const CeedScalar *qweight, int *basis, int *err) {
441a8de75f0Sjeremylt   if (CeedBasis_count == CeedBasis_count_max) {
442a8de75f0Sjeremylt     CeedBasis_count_max += CeedBasis_count_max/2 + 1;
443a8de75f0Sjeremylt     CeedRealloc(CeedBasis_count_max, &CeedBasis_dict);
444a8de75f0Sjeremylt   }
445a8de75f0Sjeremylt 
4468795c945Sjeremylt   *err = CeedBasisCreateH1(Ceed_dict[*ceed], *topo, *ncomp, *nnodes, *nqpts,
4478795c945Sjeremylt                            interp, grad, qref, qweight,
4488795c945Sjeremylt                            &CeedBasis_dict[CeedBasis_count]);
449a8de75f0Sjeremylt 
450a8de75f0Sjeremylt   if (*err == 0) {
451a8de75f0Sjeremylt     *basis = CeedBasis_count++;
452a8de75f0Sjeremylt     CeedBasis_n++;
453a8de75f0Sjeremylt   }
454a8de75f0Sjeremylt }
455a8de75f0Sjeremylt 
456d7b241e6Sjeremylt #define fCeedBasisView FORTRAN_NAME(ceedbasisview, CEEDBASISVIEW)
457d7b241e6Sjeremylt void fCeedBasisView(int *basis, int *err) {
458d7b241e6Sjeremylt   *err = CeedBasisView(CeedBasis_dict[*basis], stdout);
459d7b241e6Sjeremylt }
460d7b241e6Sjeremylt 
461d7b241e6Sjeremylt #define fCeedQRFactorization \
462d7b241e6Sjeremylt     FORTRAN_NAME(ceedqrfactorization, CEEDQRFACTORIZATION)
463a7bd39daSjeremylt void fCeedQRFactorization(int *ceed, CeedScalar *mat, CeedScalar *tau, int *m,
464a7bd39daSjeremylt                           int *n, int *err) {
465a7bd39daSjeremylt   *err = CeedQRFactorization(Ceed_dict[*ceed], mat, tau, *m, *n);
466d7b241e6Sjeremylt }
467d7b241e6Sjeremylt 
46852bfb9bbSJeremy L Thompson #define fCeedSymmetricSchurDecomposition \
46952bfb9bbSJeremy L Thompson     FORTRAN_NAME(ceedsymmetricschurdecomposition, CEEDSYMMETRICSCHURDECOMPOSITION)
47052bfb9bbSJeremy L Thompson void fCeedSymmetricSchurDecomposition(int *ceed, CeedScalar *mat,
47152bfb9bbSJeremy L Thompson                                       CeedScalar *lambda, int *n, int *err) {
47252bfb9bbSJeremy L Thompson   *err = CeedSymmetricSchurDecomposition(Ceed_dict[*ceed], mat, lambda, *n);
47352bfb9bbSJeremy L Thompson }
47452bfb9bbSJeremy L Thompson 
47552bfb9bbSJeremy L Thompson #define fCeedSimultaneousDiagonalization \
47652bfb9bbSJeremy L Thompson     FORTRAN_NAME(ceedsimultaneousdiagonalization, CEEDSIMULTANEOUSDIAGONALIZATION)
47752bfb9bbSJeremy L Thompson void fCeedSimultaneousDiagonalization(int *ceed, CeedScalar *matA,
47852bfb9bbSJeremy L Thompson                                       CeedScalar *matB, CeedScalar *x,
47952bfb9bbSJeremy L Thompson                                       CeedScalar *lambda, int *n, int *err) {
48052bfb9bbSJeremy L Thompson   *err = CeedSimultaneousDiagonalization(Ceed_dict[*ceed], matA, matB, x,
48152bfb9bbSJeremy L Thompson                                          lambda, *n);
48252bfb9bbSJeremy L Thompson }
48352bfb9bbSJeremy L Thompson 
484783c99b3SValeria Barra #define fCeedBasisGetCollocatedGrad \
485783c99b3SValeria Barra     FORTRAN_NAME(ceedbasisgetcollocatedgrad, CEEDBASISGETCOLLOCATEDGRAD)
486783c99b3SValeria Barra void fCeedBasisGetCollocatedGrad(int *basis, CeedScalar *colograd1d,
487d7b241e6Sjeremylt                                  int *err) {
488783c99b3SValeria Barra   *err = CeedBasisGetCollocatedGrad(CeedBasis_dict[*basis], colograd1d);
489d7b241e6Sjeremylt }
490d7b241e6Sjeremylt 
491d7b241e6Sjeremylt #define fCeedBasisApply FORTRAN_NAME(ceedbasisapply, CEEDBASISAPPLY)
492d7b241e6Sjeremylt void fCeedBasisApply(int *basis, int *nelem, int *tmode, int *emode,
493aedaa0e5Sjeremylt                      int *u, int *v, int *err) {
494aedaa0e5Sjeremylt   *err = CeedBasisApply(CeedBasis_dict[*basis], *nelem, *tmode, *emode,
495a7b7f929Sjeremylt                         *u==FORTRAN_VECTOR_NONE?
496a7b7f929Sjeremylt                         CEED_VECTOR_NONE:CeedVector_dict[*u],
497aedaa0e5Sjeremylt                         CeedVector_dict[*v]);
498d7b241e6Sjeremylt }
499d7b241e6Sjeremylt 
500d7b241e6Sjeremylt #define fCeedBasisGetNumNodes \
501d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasisgetnumnodes, CEEDBASISGETNUMNODES)
502d7b241e6Sjeremylt void fCeedBasisGetNumNodes(int *basis, int *P, int *err) {
503d7b241e6Sjeremylt   *err = CeedBasisGetNumNodes(CeedBasis_dict[*basis], P);
504d7b241e6Sjeremylt }
505d7b241e6Sjeremylt 
506d7b241e6Sjeremylt #define fCeedBasisGetNumQuadraturePoints \
507d7b241e6Sjeremylt     FORTRAN_NAME(ceedbasisgetnumquadraturepoints, CEEDBASISGETNUMQUADRATUREPOINTS)
508d7b241e6Sjeremylt void fCeedBasisGetNumQuadraturePoints(int *basis, int *Q, int *err) {
509d7b241e6Sjeremylt   *err = CeedBasisGetNumQuadraturePoints(CeedBasis_dict[*basis], Q);
510d7b241e6Sjeremylt }
511d7b241e6Sjeremylt 
512d7b241e6Sjeremylt #define fCeedBasisDestroy FORTRAN_NAME(ceedbasisdestroy,CEEDBASISDESTROY)
513d7b241e6Sjeremylt void fCeedBasisDestroy(int *basis, int *err) {
514d7b241e6Sjeremylt   *err = CeedBasisDestroy(&CeedBasis_dict[*basis]);
515d7b241e6Sjeremylt 
516d7b241e6Sjeremylt   if (*err == 0) {
517d7b241e6Sjeremylt     CeedBasis_n--;
518d7b241e6Sjeremylt     if (CeedBasis_n == 0) {
519d7b241e6Sjeremylt       CeedFree(&CeedBasis_dict);
520d7b241e6Sjeremylt       CeedBasis_count = 0;
521d7b241e6Sjeremylt       CeedBasis_count_max = 0;
522d7b241e6Sjeremylt     }
523d7b241e6Sjeremylt   }
524d7b241e6Sjeremylt }
525d7b241e6Sjeremylt 
526d7b241e6Sjeremylt #define fCeedGaussQuadrature FORTRAN_NAME(ceedgaussquadrature, CEEDGAUSSQUADRATURE)
527d7b241e6Sjeremylt void fCeedGaussQuadrature(int *Q, CeedScalar *qref1d, CeedScalar *qweight1d,
528d7b241e6Sjeremylt                           int *err) {
529d7b241e6Sjeremylt   *err = CeedGaussQuadrature(*Q, qref1d, qweight1d);
530d7b241e6Sjeremylt }
531d7b241e6Sjeremylt 
532d7b241e6Sjeremylt #define fCeedLobattoQuadrature \
533d7b241e6Sjeremylt     FORTRAN_NAME(ceedlobattoquadrature, CEEDLOBATTOQUADRATURE)
534d7b241e6Sjeremylt void fCeedLobattoQuadrature(int *Q, CeedScalar *qref1d, CeedScalar *qweight1d,
535d7b241e6Sjeremylt                             int *err) {
536d7b241e6Sjeremylt   *err = CeedLobattoQuadrature(*Q, qref1d, qweight1d);
537d7b241e6Sjeremylt }
538d7b241e6Sjeremylt 
539d7b241e6Sjeremylt static CeedQFunction *CeedQFunction_dict = NULL;
540d7b241e6Sjeremylt static int CeedQFunction_count = 0;
541d7b241e6Sjeremylt static int CeedQFunction_n = 0;
542d7b241e6Sjeremylt static int CeedQFunction_count_max = 0;
543d7b241e6Sjeremylt 
544d7b241e6Sjeremylt static int CeedQFunctionFortranStub(void *ctx, int nq,
5458795c945Sjeremylt                                     const CeedScalar *const *u,
5468795c945Sjeremylt                                     CeedScalar *const *v) {
547418fb8c2Sjeremylt   fContext *fctx = ctx;
548d7b241e6Sjeremylt   int ierr;
549d7b241e6Sjeremylt 
5501e35832bSjeremylt   CeedScalar *ctx_ = (CeedScalar *) fctx->innerctx;
5511e35832bSjeremylt   fctx->f((void *)ctx_,&nq,u[0],u[1],u[2],u[3],u[4],u[5],u[6],
552418fb8c2Sjeremylt           u[7],u[8],u[9],u[10],u[11],u[12],u[13],u[14],u[15],
553418fb8c2Sjeremylt           v[0],v[1],v[2],v[3],v[4],v[5],v[6],v[7],v[8],v[9],
554418fb8c2Sjeremylt           v[10],v[11],v[12],v[13],v[14],v[15],&ierr);
555d7b241e6Sjeremylt   return ierr;
556d7b241e6Sjeremylt }
557d7b241e6Sjeremylt 
558d7b241e6Sjeremylt #define fCeedQFunctionCreateInterior \
559d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctioncreateinterior, CEEDQFUNCTIONCREATEINTERIOR)
560d7b241e6Sjeremylt void fCeedQFunctionCreateInterior(int *ceed, int *vlength,
561d7b241e6Sjeremylt                                   void (*f)(void *ctx, int *nq,
562418fb8c2Sjeremylt                                       const CeedScalar *u,const CeedScalar *u1,
563418fb8c2Sjeremylt                                       const CeedScalar *u2,const CeedScalar *u3,
564418fb8c2Sjeremylt                                       const CeedScalar *u4,const CeedScalar *u5,
565418fb8c2Sjeremylt                                       const CeedScalar *u6,const CeedScalar *u7,
566418fb8c2Sjeremylt                                       const CeedScalar *u8,const CeedScalar *u9,
567418fb8c2Sjeremylt                                       const CeedScalar *u10,const CeedScalar *u11,
568418fb8c2Sjeremylt                                       const CeedScalar *u12,const CeedScalar *u13,
569418fb8c2Sjeremylt                                       const CeedScalar *u14,const CeedScalar *u15,
570418fb8c2Sjeremylt                                       CeedScalar *v,CeedScalar *v1,CeedScalar *v2,
5718795c945Sjeremylt                                       CeedScalar *v3,CeedScalar *v4,
5728795c945Sjeremylt                                       CeedScalar *v5,CeedScalar *v6,
5738795c945Sjeremylt                                       CeedScalar *v7,CeedScalar *v8,
5748795c945Sjeremylt                                       CeedScalar *v9,CeedScalar *v10,
5758795c945Sjeremylt                                       CeedScalar *v11,CeedScalar *v12,
5768795c945Sjeremylt                                       CeedScalar *v13,CeedScalar *v14,
577418fb8c2Sjeremylt                                       CeedScalar *v15,int *err),
578288c0443SJeremy L Thompson                                   const char *source, int *qf, int *err,
579288c0443SJeremy L Thompson                                   fortran_charlen_t source_len) {
580288c0443SJeremy L Thompson   FIX_STRING(source);
581d7b241e6Sjeremylt   if (CeedQFunction_count == CeedQFunction_count_max) {
582d7b241e6Sjeremylt     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
583d7b241e6Sjeremylt     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
584d7b241e6Sjeremylt   }
585d7b241e6Sjeremylt 
586d7b241e6Sjeremylt   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
587d7b241e6Sjeremylt   *err = CeedQFunctionCreateInterior(Ceed_dict[*ceed], *vlength,
588288c0443SJeremy L Thompson                                      CeedQFunctionFortranStub, source_c, qf_);
589d7b241e6Sjeremylt 
590d7b241e6Sjeremylt   if (*err == 0) {
591d7b241e6Sjeremylt     *qf = CeedQFunction_count++;
592d7b241e6Sjeremylt     CeedQFunction_n++;
593d7b241e6Sjeremylt   }
594d7b241e6Sjeremylt 
595418fb8c2Sjeremylt   fContext *fctx;
596d7b241e6Sjeremylt   *err = CeedMalloc(1, &fctx);
597d7b241e6Sjeremylt   if (*err) return;
598418fb8c2Sjeremylt   fctx->f = f; fctx->innerctx = NULL; fctx->innerctxsize = 0;
599d7b241e6Sjeremylt 
600418fb8c2Sjeremylt   *err = CeedQFunctionSetContext(*qf_, fctx, sizeof(fContext));
601d7b241e6Sjeremylt 
602418fb8c2Sjeremylt   (*qf_)->fortranstatus = true;
603d7b241e6Sjeremylt }
604d7b241e6Sjeremylt 
605288c0443SJeremy L Thompson #define fCeedQFunctionCreateInteriorByName \
606288c0443SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncreateinteriorbyname, CEEDQFUNCTIONCREATEINTERIORBYNAME)
607288c0443SJeremy L Thompson void fCeedQFunctionCreateInteriorByName(int *ceed, const char *name, int *qf,
608288c0443SJeremy L Thompson                                         int *err, fortran_charlen_t name_len) {
609288c0443SJeremy L Thompson   FIX_STRING(name);
610288c0443SJeremy L Thompson   if (CeedQFunction_count == CeedQFunction_count_max) {
611288c0443SJeremy L Thompson     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
612288c0443SJeremy L Thompson     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
613288c0443SJeremy L Thompson   }
614288c0443SJeremy L Thompson 
615288c0443SJeremy L Thompson   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
616288c0443SJeremy L Thompson   *err = CeedQFunctionCreateInteriorByName(Ceed_dict[*ceed], name_c, qf_);
617288c0443SJeremy L Thompson 
618288c0443SJeremy L Thompson   if (*err == 0) {
619288c0443SJeremy L Thompson     *qf = CeedQFunction_count++;
620288c0443SJeremy L Thompson     CeedQFunction_n++;
621288c0443SJeremy L Thompson   }
622288c0443SJeremy L Thompson }
623288c0443SJeremy L Thompson 
6240219ea01SJeremy L Thompson #define fCeedQFunctionCreateIdentity \
6250219ea01SJeremy L Thompson     FORTRAN_NAME(ceedqfunctioncreateidentity, CEEDQFUNCTIONCREATEIDENTITY)
62660f77c51Sjeremylt void fCeedQFunctionCreateIdentity(int *ceed, int *size, int *inmode,
62760f77c51Sjeremylt                                   int *outmode, int *qf, int *err) {
6280219ea01SJeremy L Thompson   if (CeedQFunction_count == CeedQFunction_count_max) {
6290219ea01SJeremy L Thompson     CeedQFunction_count_max += CeedQFunction_count_max/2 + 1;
6300219ea01SJeremy L Thompson     CeedRealloc(CeedQFunction_count_max, &CeedQFunction_dict);
6310219ea01SJeremy L Thompson   }
6320219ea01SJeremy L Thompson 
6330219ea01SJeremy L Thompson   CeedQFunction *qf_ = &CeedQFunction_dict[CeedQFunction_count];
63460f77c51Sjeremylt   *err = CeedQFunctionCreateIdentity(Ceed_dict[*ceed], *size, *inmode,
63560f77c51Sjeremylt                                      *outmode, qf_);
6360219ea01SJeremy L Thompson 
6370219ea01SJeremy L Thompson   if (*err == 0) {
6380219ea01SJeremy L Thompson     *qf = CeedQFunction_count++;
6390219ea01SJeremy L Thompson     CeedQFunction_n++;
6400219ea01SJeremy L Thompson   }
6410219ea01SJeremy L Thompson }
6420219ea01SJeremy L Thompson 
643d7b241e6Sjeremylt #define fCeedQFunctionAddInput \
644d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionaddinput,CEEDQFUNCTIONADDINPUT)
645d7b241e6Sjeremylt void fCeedQFunctionAddInput(int *qf, const char *fieldname,
646c2ae719dSJed Brown                             CeedInt *ncomp, CeedEvalMode *emode, int *err,
647c2ae719dSJed Brown                             fortran_charlen_t fieldname_len) {
648c2ae719dSJed Brown   FIX_STRING(fieldname);
649d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
650d7b241e6Sjeremylt 
651c2ae719dSJed Brown   *err = CeedQFunctionAddInput(qf_, fieldname_c, *ncomp, *emode);
652d7b241e6Sjeremylt }
653d7b241e6Sjeremylt 
654d7b241e6Sjeremylt #define fCeedQFunctionAddOutput \
655d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionaddoutput,CEEDQFUNCTIONADDOUTPUT)
656d7b241e6Sjeremylt void fCeedQFunctionAddOutput(int *qf, const char *fieldname,
657c2ae719dSJed Brown                              CeedInt *ncomp, CeedEvalMode *emode, int *err,
658c2ae719dSJed Brown                              fortran_charlen_t fieldname_len) {
659c2ae719dSJed Brown   FIX_STRING(fieldname);
660d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
661d7b241e6Sjeremylt 
662c2ae719dSJed Brown   *err = CeedQFunctionAddOutput(qf_, fieldname_c, *ncomp, *emode);
663d7b241e6Sjeremylt }
664d7b241e6Sjeremylt 
665418fb8c2Sjeremylt #define fCeedQFunctionSetContext \
666418fb8c2Sjeremylt     FORTRAN_NAME(ceedqfunctionsetcontext,CEEDQFUNCTIONSETCONTEXT)
667418fb8c2Sjeremylt void fCeedQFunctionSetContext(int *qf, CeedScalar *ctx, CeedInt *n, int *err) {
668418fb8c2Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
669418fb8c2Sjeremylt 
670418fb8c2Sjeremylt   fContext *fctx = qf_->ctx;
671418fb8c2Sjeremylt   fctx->innerctx = ctx;
6721e35832bSjeremylt   fctx->innerctxsize = ((size_t) *n)*sizeof(CeedScalar);
673418fb8c2Sjeremylt }
674418fb8c2Sjeremylt 
67575affc3bSjeremylt #define fCeedQFunctionView \
67675affc3bSjeremylt     FORTRAN_NAME(ceedqfunctionview,CEEDQFUNCTIONVIEW)
67775affc3bSjeremylt void fCeedQFunctionView(int *qf, int *err) {
67875affc3bSjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
67975affc3bSjeremylt 
68075affc3bSjeremylt   *err = CeedQFunctionView(qf_, stdout);
68175affc3bSjeremylt }
68275affc3bSjeremylt 
683d7b241e6Sjeremylt #define fCeedQFunctionApply \
684d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctionapply,CEEDQFUNCTIONAPPLY)
685d7b241e6Sjeremylt //TODO Need Fixing, double pointer
686d7b241e6Sjeremylt void fCeedQFunctionApply(int *qf, int *Q,
687aedaa0e5Sjeremylt                          int *u, int *u1, int *u2, int *u3,
688aedaa0e5Sjeremylt                          int *u4, int *u5, int *u6, int *u7,
689aedaa0e5Sjeremylt                          int *u8, int *u9, int *u10, int *u11,
690aedaa0e5Sjeremylt                          int *u12, int *u13, int *u14, int *u15,
691aedaa0e5Sjeremylt                          int *v, int *v1, int *v2, int *v3,
692aedaa0e5Sjeremylt                          int *v4, int *v5, int *v6, int *v7,
693aedaa0e5Sjeremylt                          int *v8, int *v9, int *v10, int *v11,
694aedaa0e5Sjeremylt                          int *v12, int *v13, int *v14, int *v15, int *err) {
695d7b241e6Sjeremylt   CeedQFunction qf_ = CeedQFunction_dict[*qf];
696aedaa0e5Sjeremylt   CeedVector *in;
697d7b241e6Sjeremylt   *err = CeedCalloc(16, &in);
698d7b241e6Sjeremylt   if (*err) return;
699aedaa0e5Sjeremylt   in[0] = *u==FORTRAN_NULL?NULL:CeedVector_dict[*u];
700aedaa0e5Sjeremylt   in[1] = *u1==FORTRAN_NULL?NULL:CeedVector_dict[*u1];
701aedaa0e5Sjeremylt   in[2] = *u2==FORTRAN_NULL?NULL:CeedVector_dict[*u2];
702aedaa0e5Sjeremylt   in[3] = *u3==FORTRAN_NULL?NULL:CeedVector_dict[*u3];
703aedaa0e5Sjeremylt   in[4] = *u4==FORTRAN_NULL?NULL:CeedVector_dict[*u4];
704aedaa0e5Sjeremylt   in[5] = *u5==FORTRAN_NULL?NULL:CeedVector_dict[*u5];
705aedaa0e5Sjeremylt   in[6] = *u6==FORTRAN_NULL?NULL:CeedVector_dict[*u6];
706aedaa0e5Sjeremylt   in[7] = *u7==FORTRAN_NULL?NULL:CeedVector_dict[*u7];
707aedaa0e5Sjeremylt   in[8] = *u8==FORTRAN_NULL?NULL:CeedVector_dict[*u8];
708aedaa0e5Sjeremylt   in[9] = *u9==FORTRAN_NULL?NULL:CeedVector_dict[*u9];
709aedaa0e5Sjeremylt   in[10] = *u10==FORTRAN_NULL?NULL:CeedVector_dict[*u10];
710aedaa0e5Sjeremylt   in[11] = *u11==FORTRAN_NULL?NULL:CeedVector_dict[*u11];
711aedaa0e5Sjeremylt   in[12] = *u12==FORTRAN_NULL?NULL:CeedVector_dict[*u12];
712aedaa0e5Sjeremylt   in[13] = *u13==FORTRAN_NULL?NULL:CeedVector_dict[*u13];
713aedaa0e5Sjeremylt   in[14] = *u14==FORTRAN_NULL?NULL:CeedVector_dict[*u14];
714aedaa0e5Sjeremylt   in[15] = *u15==FORTRAN_NULL?NULL:CeedVector_dict[*u15];
715aedaa0e5Sjeremylt   CeedVector *out;
716d7b241e6Sjeremylt   *err = CeedCalloc(16, &out);
717d7b241e6Sjeremylt   if (*err) return;
718aedaa0e5Sjeremylt   out[0] = *v==FORTRAN_NULL?NULL:CeedVector_dict[*v];
719aedaa0e5Sjeremylt   out[1] = *v1==FORTRAN_NULL?NULL:CeedVector_dict[*v1];
720aedaa0e5Sjeremylt   out[2] = *v2==FORTRAN_NULL?NULL:CeedVector_dict[*v2];
721aedaa0e5Sjeremylt   out[3] = *v3==FORTRAN_NULL?NULL:CeedVector_dict[*v3];
722aedaa0e5Sjeremylt   out[4] = *v4==FORTRAN_NULL?NULL:CeedVector_dict[*v4];
723aedaa0e5Sjeremylt   out[5] = *v5==FORTRAN_NULL?NULL:CeedVector_dict[*v5];
724aedaa0e5Sjeremylt   out[6] = *v6==FORTRAN_NULL?NULL:CeedVector_dict[*v6];
725aedaa0e5Sjeremylt   out[7] = *v7==FORTRAN_NULL?NULL:CeedVector_dict[*v7];
726aedaa0e5Sjeremylt   out[8] = *v8==FORTRAN_NULL?NULL:CeedVector_dict[*v8];
727aedaa0e5Sjeremylt   out[9] = *v9==FORTRAN_NULL?NULL:CeedVector_dict[*v9];
728aedaa0e5Sjeremylt   out[10] = *v10==FORTRAN_NULL?NULL:CeedVector_dict[*v10];
729aedaa0e5Sjeremylt   out[11] = *v11==FORTRAN_NULL?NULL:CeedVector_dict[*v11];
730aedaa0e5Sjeremylt   out[12] = *v12==FORTRAN_NULL?NULL:CeedVector_dict[*v12];
731aedaa0e5Sjeremylt   out[13] = *v13==FORTRAN_NULL?NULL:CeedVector_dict[*v13];
732aedaa0e5Sjeremylt   out[14] = *v14==FORTRAN_NULL?NULL:CeedVector_dict[*v14];
733aedaa0e5Sjeremylt   out[15] = *v15==FORTRAN_NULL?NULL:CeedVector_dict[*v15];
734aedaa0e5Sjeremylt   *err = CeedQFunctionApply(qf_, *Q, in, out);
735d7b241e6Sjeremylt   if (*err) return;
736d7b241e6Sjeremylt 
737d7b241e6Sjeremylt   *err = CeedFree(&in);
738d7b241e6Sjeremylt   if (*err) return;
739d7b241e6Sjeremylt   *err = CeedFree(&out);
740d7b241e6Sjeremylt }
741d7b241e6Sjeremylt 
742d7b241e6Sjeremylt #define fCeedQFunctionDestroy \
743d7b241e6Sjeremylt     FORTRAN_NAME(ceedqfunctiondestroy,CEEDQFUNCTIONDESTROY)
744d7b241e6Sjeremylt void fCeedQFunctionDestroy(int *qf, int *err) {
7451134a487Sjeremylt   bool fstatus;
7461134a487Sjeremylt   *err = CeedQFunctionGetFortranStatus(CeedQFunction_dict[*qf], &fstatus);
7471134a487Sjeremylt   if (*err) return;
7481134a487Sjeremylt   if (fstatus) {
749c4b814baSjeremylt     fContext *fctx = CeedQFunction_dict[*qf]->ctx;
750c4b814baSjeremylt     *err = CeedFree(&fctx);
751d7b241e6Sjeremylt     if (*err) return;
7521134a487Sjeremylt   }
753c4b814baSjeremylt 
754c4b814baSjeremylt   *err = CeedQFunctionDestroy(&CeedQFunction_dict[*qf]);
755c4b814baSjeremylt   if (*err) return;
756c4b814baSjeremylt 
757d7b241e6Sjeremylt   CeedQFunction_n--;
758d7b241e6Sjeremylt   if (CeedQFunction_n == 0) {
759d7b241e6Sjeremylt     *err = CeedFree(&CeedQFunction_dict);
760d7b241e6Sjeremylt     CeedQFunction_count = 0;
761d7b241e6Sjeremylt     CeedQFunction_count_max = 0;
762d7b241e6Sjeremylt   }
763d7b241e6Sjeremylt }
764d7b241e6Sjeremylt 
765d7b241e6Sjeremylt static CeedOperator *CeedOperator_dict = NULL;
766d7b241e6Sjeremylt static int CeedOperator_count = 0;
767d7b241e6Sjeremylt static int CeedOperator_n = 0;
768d7b241e6Sjeremylt static int CeedOperator_count_max = 0;
769d7b241e6Sjeremylt 
770d7b241e6Sjeremylt #define fCeedOperatorCreate \
771d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorcreate, CEEDOPERATORCREATE)
772d7b241e6Sjeremylt void fCeedOperatorCreate(int *ceed,
773d7b241e6Sjeremylt                          int *qf, int *dqf, int *dqfT, int *op, int *err) {
774d7b241e6Sjeremylt   if (CeedOperator_count == CeedOperator_count_max)
775d7b241e6Sjeremylt     CeedOperator_count_max += CeedOperator_count_max/2 + 1,
7768795c945Sjeremylt                               CeedOperator_dict = realloc(CeedOperator_dict,
7778795c945Sjeremylt                                   sizeof(CeedOperator)*CeedOperator_count_max);
778d7b241e6Sjeremylt 
779d7b241e6Sjeremylt   CeedOperator *op_ = &CeedOperator_dict[CeedOperator_count];
780d7b241e6Sjeremylt 
781442e7f0bSjeremylt   CeedQFunction dqf_  = CEED_QFUNCTION_NONE, dqfT_ = CEED_QFUNCTION_NONE;
782442e7f0bSjeremylt   if (*dqf  != FORTRAN_QFUNCTION_NONE) dqf_  = CeedQFunction_dict[*dqf ];
783442e7f0bSjeremylt   if (*dqfT != FORTRAN_QFUNCTION_NONE) dqfT_ = CeedQFunction_dict[*dqfT];
784d7b241e6Sjeremylt 
785d7b241e6Sjeremylt   *err = CeedOperatorCreate(Ceed_dict[*ceed], CeedQFunction_dict[*qf], dqf_,
786d7b241e6Sjeremylt                             dqfT_, op_);
787d7b241e6Sjeremylt   if (*err) return;
788d7b241e6Sjeremylt   *op = CeedOperator_count++;
789d7b241e6Sjeremylt   CeedOperator_n++;
790d7b241e6Sjeremylt }
791d7b241e6Sjeremylt 
79252d6035fSJeremy L Thompson #define fCeedCompositeOperatorCreate \
79352d6035fSJeremy L Thompson     FORTRAN_NAME(ceedcompositeoperatorcreate, CEEDCOMPOSITEOPERATORCREATE)
79452d6035fSJeremy L Thompson void fCeedCompositeOperatorCreate(int *ceed, int *op, int *err) {
79552d6035fSJeremy L Thompson   if (CeedOperator_count == CeedOperator_count_max)
79652d6035fSJeremy L Thompson     CeedOperator_count_max += CeedOperator_count_max/2 + 1,
7978795c945Sjeremylt                               CeedOperator_dict = realloc(CeedOperator_dict,
7988795c945Sjeremylt                                   sizeof(CeedOperator)*CeedOperator_count_max);
79952d6035fSJeremy L Thompson 
80052d6035fSJeremy L Thompson   CeedOperator *op_ = &CeedOperator_dict[CeedOperator_count];
80152d6035fSJeremy L Thompson 
80252d6035fSJeremy L Thompson   *err = CeedCompositeOperatorCreate(Ceed_dict[*ceed], op_);
80352d6035fSJeremy L Thompson   if (*err) return;
80452d6035fSJeremy L Thompson   *op = CeedOperator_count++;
80552d6035fSJeremy L Thompson   CeedOperator_n++;
80652d6035fSJeremy L Thompson }
80752d6035fSJeremy L Thompson 
808d7b241e6Sjeremylt #define fCeedOperatorSetField \
809d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorsetfield,CEEDOPERATORSETFIELD)
810d7b241e6Sjeremylt void fCeedOperatorSetField(int *op, const char *fieldname,
8114dccadb6Sjeremylt                            int *r, int *lmode, int *b, int *v, int *err,
812c2ae719dSJed Brown                            fortran_charlen_t fieldname_len) {
813c2ae719dSJed Brown   FIX_STRING(fieldname);
814d7b241e6Sjeremylt   CeedElemRestriction r_;
815d7b241e6Sjeremylt   CeedBasis b_;
816d7b241e6Sjeremylt   CeedVector v_;
817d7b241e6Sjeremylt 
818d7b241e6Sjeremylt   CeedOperator op_ = CeedOperator_dict[*op];
819d7b241e6Sjeremylt 
820d7b241e6Sjeremylt   if (*r == FORTRAN_NULL) {
821d7b241e6Sjeremylt     r_ = NULL;
822d7b241e6Sjeremylt   } else {
823d7b241e6Sjeremylt     r_ = CeedElemRestriction_dict[*r];
824d7b241e6Sjeremylt   }
8254dccadb6Sjeremylt 
826d7b241e6Sjeremylt   if (*b == FORTRAN_NULL) {
827d7b241e6Sjeremylt     b_ = NULL;
828783c99b3SValeria Barra   } else if (*b == FORTRAN_BASIS_COLLOCATED) {
829783c99b3SValeria Barra     b_ = CEED_BASIS_COLLOCATED;
830d7b241e6Sjeremylt   } else {
831d7b241e6Sjeremylt     b_ = CeedBasis_dict[*b];
832d7b241e6Sjeremylt   }
833d7b241e6Sjeremylt   if (*v == FORTRAN_NULL) {
834d7b241e6Sjeremylt     v_ = NULL;
835d7b241e6Sjeremylt   } else if (*v == FORTRAN_VECTOR_ACTIVE) {
836d7b241e6Sjeremylt     v_ = CEED_VECTOR_ACTIVE;
837d7b241e6Sjeremylt   } else if (*v == FORTRAN_VECTOR_NONE) {
838d7b241e6Sjeremylt     v_ = CEED_VECTOR_NONE;
839d7b241e6Sjeremylt   } else {
840d7b241e6Sjeremylt     v_ = CeedVector_dict[*v];
841d7b241e6Sjeremylt   }
842d7b241e6Sjeremylt 
8434dccadb6Sjeremylt   *err = CeedOperatorSetField(op_, fieldname_c, r_, *lmode, b_, v_);
844d7b241e6Sjeremylt }
845d7b241e6Sjeremylt 
84652d6035fSJeremy L Thompson #define fCeedCompositeOperatorAddSub \
84752d6035fSJeremy L Thompson     FORTRAN_NAME(ceedcompositeoperatoraddsub, CEEDCOMPOSITEOPERATORADDSUB)
84852d6035fSJeremy L Thompson void fCeedCompositeOperatorAddSub(int *compositeop, int *subop, int *err) {
84952d6035fSJeremy L Thompson   CeedOperator compositeop_ = CeedOperator_dict[*compositeop];
85052d6035fSJeremy L Thompson   CeedOperator subop_ = CeedOperator_dict[*subop];
85152d6035fSJeremy L Thompson 
85252d6035fSJeremy L Thompson   *err = CeedCompositeOperatorAddSub(compositeop_, subop_);
85352d6035fSJeremy L Thompson   if (*err) return;
85452d6035fSJeremy L Thompson }
85552d6035fSJeremy L Thompson 
8561d102b48SJeremy L Thompson #define fCeedOperatorAssembleLinearQFunction FORTRAN_NAME(ceedoperatorassemblelinearqfunction, CEEDOPERATORASSEMBLELINEARQFUNCTION)
8571d102b48SJeremy L Thompson void fCeedOperatorAssembleLinearQFunction(int *op, int *assembledvec,
8581d102b48SJeremy L Thompson     int *assembledrstr, int *rqst, int *err) {
8591d102b48SJeremy L Thompson   // Vector
8601d102b48SJeremy L Thompson   if (CeedVector_count == CeedVector_count_max) {
8611d102b48SJeremy L Thompson     CeedVector_count_max += CeedVector_count_max/2 + 1;
8621d102b48SJeremy L Thompson     CeedRealloc(CeedVector_count_max, &CeedVector_dict);
8631d102b48SJeremy L Thompson   }
8641d102b48SJeremy L Thompson   CeedVector *assembledvec_ = &CeedVector_dict[CeedVector_count];
8651d102b48SJeremy L Thompson 
8661d102b48SJeremy L Thompson   // Restriction
8671d102b48SJeremy L Thompson   if (CeedElemRestriction_count == CeedElemRestriction_count_max) {
8681d102b48SJeremy L Thompson     CeedElemRestriction_count_max += CeedElemRestriction_count_max/2 + 1;
8691d102b48SJeremy L Thompson     CeedRealloc(CeedElemRestriction_count_max, &CeedElemRestriction_dict);
8701d102b48SJeremy L Thompson   }
8711d102b48SJeremy L Thompson   CeedElemRestriction *rstr_ =
8721d102b48SJeremy L Thompson     &CeedElemRestriction_dict[CeedElemRestriction_count];
8731d102b48SJeremy L Thompson 
8741d102b48SJeremy L Thompson   int createRequest = 1;
8751d102b48SJeremy L Thompson   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
8761d102b48SJeremy L Thompson   if (*rqst == -1 || *rqst == -2) {
8771d102b48SJeremy L Thompson     createRequest = 0;
8781d102b48SJeremy L Thompson   }
8791d102b48SJeremy L Thompson 
8801d102b48SJeremy L Thompson   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
8811d102b48SJeremy L Thompson     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
8821d102b48SJeremy L Thompson     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
8831d102b48SJeremy L Thompson   }
8841d102b48SJeremy L Thompson 
8851d102b48SJeremy L Thompson   CeedRequest *rqst_;
8861d102b48SJeremy L Thompson   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
8871d102b48SJeremy L Thompson   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
8881d102b48SJeremy L Thompson   else rqst_ = &CeedRequest_dict[CeedRequest_count];
8891d102b48SJeremy L Thompson 
8901d102b48SJeremy L Thompson   *err = CeedOperatorAssembleLinearQFunction(CeedOperator_dict[*op],
8911d102b48SJeremy L Thompson          assembledvec_, rstr_, rqst_);
8921d102b48SJeremy L Thompson   if (*err) return;
8931d102b48SJeremy L Thompson   if (createRequest) {
8941d102b48SJeremy L Thompson     *rqst = CeedRequest_count++;
8951d102b48SJeremy L Thompson     CeedRequest_n++;
8961d102b48SJeremy L Thompson   }
8971d102b48SJeremy L Thompson 
8981d102b48SJeremy L Thompson   if (*err == 0) {
8991d102b48SJeremy L Thompson     *assembledrstr = CeedElemRestriction_count++;
9001d102b48SJeremy L Thompson     CeedElemRestriction_n++;
9011d102b48SJeremy L Thompson     *assembledvec = CeedVector_count++;
9021d102b48SJeremy L Thompson     CeedVector_n++;
9031d102b48SJeremy L Thompson   }
9041d102b48SJeremy L Thompson }
9051d102b48SJeremy L Thompson 
906b7ec98d8SJeremy L Thompson #define fCeedOperatorAssembleLinearDiagonal FORTRAN_NAME(ceedoperatorassemblelineardiagonal, CEEDOPERATORASSEMBLELINEARDIAGONAL)
907b7ec98d8SJeremy L Thompson void fCeedOperatorAssembleLinearDiagonal(int *op, int *assembledvec,
908b7ec98d8SJeremy L Thompson     int *rqst, int *err) {
909b7ec98d8SJeremy L Thompson   // Vector
910b7ec98d8SJeremy L Thompson   if (CeedVector_count == CeedVector_count_max) {
911b7ec98d8SJeremy L Thompson     CeedVector_count_max += CeedVector_count_max/2 + 1;
912b7ec98d8SJeremy L Thompson     CeedRealloc(CeedVector_count_max, &CeedVector_dict);
913b7ec98d8SJeremy L Thompson   }
914b7ec98d8SJeremy L Thompson   CeedVector *assembledvec_ = &CeedVector_dict[CeedVector_count];
915b7ec98d8SJeremy L Thompson 
916b7ec98d8SJeremy L Thompson   int createRequest = 1;
917b7ec98d8SJeremy L Thompson   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
918b7ec98d8SJeremy L Thompson   if (*rqst == -1 || *rqst == -2) {
919b7ec98d8SJeremy L Thompson     createRequest = 0;
920b7ec98d8SJeremy L Thompson   }
921b7ec98d8SJeremy L Thompson 
922b7ec98d8SJeremy L Thompson   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
923b7ec98d8SJeremy L Thompson     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
924b7ec98d8SJeremy L Thompson     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
925b7ec98d8SJeremy L Thompson   }
926b7ec98d8SJeremy L Thompson 
927b7ec98d8SJeremy L Thompson   CeedRequest *rqst_;
928b7ec98d8SJeremy L Thompson   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
929b7ec98d8SJeremy L Thompson   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
930b7ec98d8SJeremy L Thompson   else rqst_ = &CeedRequest_dict[CeedRequest_count];
931b7ec98d8SJeremy L Thompson 
932b7ec98d8SJeremy L Thompson   *err = CeedOperatorAssembleLinearDiagonal(CeedOperator_dict[*op],
933b7ec98d8SJeremy L Thompson          assembledvec_, rqst_);
934b7ec98d8SJeremy L Thompson   if (*err) return;
935b7ec98d8SJeremy L Thompson   if (createRequest) {
936b7ec98d8SJeremy L Thompson     *rqst = CeedRequest_count++;
937b7ec98d8SJeremy L Thompson     CeedRequest_n++;
938b7ec98d8SJeremy L Thompson   }
939b7ec98d8SJeremy L Thompson 
940b7ec98d8SJeremy L Thompson   if (*err == 0) {
941b7ec98d8SJeremy L Thompson     *assembledvec = CeedVector_count++;
942b7ec98d8SJeremy L Thompson     CeedVector_n++;
943b7ec98d8SJeremy L Thompson   }
944b7ec98d8SJeremy L Thompson }
945b7ec98d8SJeremy L Thompson 
9462ebaca42Sjeremylt #define fCeedOperatorView \
9472ebaca42Sjeremylt     FORTRAN_NAME(ceedoperatorview,CEEDOPERATORVIEW)
9482ebaca42Sjeremylt void fCeedOperatorView(int *op, int *err) {
9492ebaca42Sjeremylt   CeedOperator op_ = CeedOperator_dict[*op];
9502ebaca42Sjeremylt 
9512ebaca42Sjeremylt   *err = CeedOperatorView(op_, stdout);
9522ebaca42Sjeremylt }
9532ebaca42Sjeremylt 
9543bd813ffSjeremylt #define fCeedOperatorCreateFDMElementInverse FORTRAN_NAME(ceedoperatorcreatefdmelementinverse, CEEDOPERATORCREATEFDMELEMENTINVERSE)
9553bd813ffSjeremylt void fCeedOperatorCreateFDMElementInverse(int *op, int *fdminv,
9563bd813ffSjeremylt     int *rqst, int *err) {
9573bd813ffSjeremylt   // Operator
9583bd813ffSjeremylt   if (CeedOperator_count == CeedOperator_count_max) {
9593bd813ffSjeremylt     CeedOperator_count_max += CeedOperator_count_max/2 + 1;
9603bd813ffSjeremylt     CeedRealloc(CeedOperator_count_max, &CeedOperator_dict);
9613bd813ffSjeremylt   }
9623bd813ffSjeremylt   CeedOperator *fdminv_ =
9633bd813ffSjeremylt     &CeedOperator_dict[CeedOperator_count];
9643bd813ffSjeremylt 
9653bd813ffSjeremylt   int createRequest = 1;
9663bd813ffSjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
9673bd813ffSjeremylt   if (*rqst == -1 || *rqst == -2) {
9683bd813ffSjeremylt     createRequest = 0;
9693bd813ffSjeremylt   }
9703bd813ffSjeremylt 
9713bd813ffSjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
9723bd813ffSjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
9733bd813ffSjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
9743bd813ffSjeremylt   }
9753bd813ffSjeremylt 
9763bd813ffSjeremylt   CeedRequest *rqst_;
9773bd813ffSjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
9783bd813ffSjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
9793bd813ffSjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
9803bd813ffSjeremylt 
9813bd813ffSjeremylt   *err = CeedOperatorCreateFDMElementInverse(CeedOperator_dict[*op],
9823bd813ffSjeremylt          fdminv_, rqst_);
9833bd813ffSjeremylt   if (*err) return;
9843bd813ffSjeremylt   if (createRequest) {
9853bd813ffSjeremylt     *rqst = CeedRequest_count++;
9863bd813ffSjeremylt     CeedRequest_n++;
9873bd813ffSjeremylt   }
9883bd813ffSjeremylt 
9893bd813ffSjeremylt   if (*err == 0) {
9903bd813ffSjeremylt     *fdminv = CeedOperator_count++;
9913bd813ffSjeremylt     CeedOperator_n++;
9923bd813ffSjeremylt   }
9933bd813ffSjeremylt }
9943bd813ffSjeremylt 
995d7b241e6Sjeremylt #define fCeedOperatorApply FORTRAN_NAME(ceedoperatorapply, CEEDOPERATORAPPLY)
996d7b241e6Sjeremylt void fCeedOperatorApply(int *op, int *ustatevec,
997d7b241e6Sjeremylt                         int *resvec, int *rqst, int *err) {
998e97ff134Sjeremylt   CeedVector ustatevec_ = (*ustatevec == FORTRAN_NULL) ?
999e97ff134Sjeremylt                           NULL : (*ustatevec == FORTRAN_VECTOR_NONE ?
1000e97ff134Sjeremylt                                   CEED_VECTOR_NONE : CeedVector_dict[*ustatevec]);
1001e97ff134Sjeremylt   CeedVector resvec_ = (*resvec == FORTRAN_NULL) ?
1002e97ff134Sjeremylt                        NULL : (*resvec == FORTRAN_VECTOR_NONE ?
1003e97ff134Sjeremylt                                CEED_VECTOR_NONE : CeedVector_dict[*resvec]);
1004d7b241e6Sjeremylt 
1005d7b241e6Sjeremylt   int createRequest = 1;
1006d7b241e6Sjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
1007d7b241e6Sjeremylt   if (*rqst == -1 || *rqst == -2) {
1008d7b241e6Sjeremylt     createRequest = 0;
1009d7b241e6Sjeremylt   }
1010d7b241e6Sjeremylt 
1011d7b241e6Sjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
1012d7b241e6Sjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
1013d7b241e6Sjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
1014d7b241e6Sjeremylt   }
1015d7b241e6Sjeremylt 
1016d7b241e6Sjeremylt   CeedRequest *rqst_;
1017d7b241e6Sjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
1018d7b241e6Sjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
1019d7b241e6Sjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
1020d7b241e6Sjeremylt 
1021d7b241e6Sjeremylt   *err = CeedOperatorApply(CeedOperator_dict[*op],
102212bf2c11SJed Brown                            ustatevec_, resvec_, rqst_);
1023d7b241e6Sjeremylt   if (*err) return;
1024d7b241e6Sjeremylt   if (createRequest) {
1025d7b241e6Sjeremylt     *rqst = CeedRequest_count++;
1026d7b241e6Sjeremylt     CeedRequest_n++;
1027d7b241e6Sjeremylt   }
1028d7b241e6Sjeremylt }
1029d7b241e6Sjeremylt 
1030cae8b89aSjeremylt #define fCeedOperatorApplyAdd FORTRAN_NAME(ceedoperatorapplyadd, CEEDOPERATORAPPLYADD)
1031cae8b89aSjeremylt void fCeedOperatorApplyAdd(int *op, int *ustatevec,
1032cae8b89aSjeremylt                            int *resvec, int *rqst, int *err) {
1033cae8b89aSjeremylt   CeedVector ustatevec_ = *ustatevec == FORTRAN_NULL
1034cae8b89aSjeremylt                           ? NULL : CeedVector_dict[*ustatevec];
1035cae8b89aSjeremylt   CeedVector resvec_ = *resvec == FORTRAN_NULL
1036cae8b89aSjeremylt                        ? NULL : CeedVector_dict[*resvec];
1037cae8b89aSjeremylt 
1038cae8b89aSjeremylt   int createRequest = 1;
1039cae8b89aSjeremylt   // Check if input is CEED_REQUEST_ORDERED(-2) or CEED_REQUEST_IMMEDIATE(-1)
1040cae8b89aSjeremylt   if (*rqst == -1 || *rqst == -2) {
1041cae8b89aSjeremylt     createRequest = 0;
1042cae8b89aSjeremylt   }
1043cae8b89aSjeremylt 
1044cae8b89aSjeremylt   if (createRequest && CeedRequest_count == CeedRequest_count_max) {
1045cae8b89aSjeremylt     CeedRequest_count_max += CeedRequest_count_max/2 + 1;
1046cae8b89aSjeremylt     CeedRealloc(CeedRequest_count_max, &CeedRequest_dict);
1047cae8b89aSjeremylt   }
1048cae8b89aSjeremylt 
1049cae8b89aSjeremylt   CeedRequest *rqst_;
1050cae8b89aSjeremylt   if (*rqst == -1) rqst_ = CEED_REQUEST_IMMEDIATE;
1051cae8b89aSjeremylt   else if (*rqst == -2) rqst_ = CEED_REQUEST_ORDERED;
1052cae8b89aSjeremylt   else rqst_ = &CeedRequest_dict[CeedRequest_count];
1053cae8b89aSjeremylt 
1054cae8b89aSjeremylt   *err = CeedOperatorApplyAdd(CeedOperator_dict[*op],
1055cae8b89aSjeremylt                               ustatevec_, resvec_, rqst_);
1056cae8b89aSjeremylt   if (*err) return;
1057cae8b89aSjeremylt   if (createRequest) {
1058cae8b89aSjeremylt     *rqst = CeedRequest_count++;
1059cae8b89aSjeremylt     CeedRequest_n++;
1060cae8b89aSjeremylt   }
1061cae8b89aSjeremylt }
1062cae8b89aSjeremylt 
1063d7b241e6Sjeremylt #define fCeedOperatorApplyJacobian \
1064d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatorapplyjacobian, CEEDOPERATORAPPLYJACOBIAN)
1065d7b241e6Sjeremylt void fCeedOperatorApplyJacobian(int *op, int *qdatavec, int *ustatevec,
10668795c945Sjeremylt                                 int *dustatevec, int *dresvec, int *rqst,
10678795c945Sjeremylt                                 int *err) {
1068d7b241e6Sjeremylt // TODO Uncomment this when CeedOperatorApplyJacobian is implemented
1069d7b241e6Sjeremylt //  *err = CeedOperatorApplyJacobian(CeedOperator_dict[*op], CeedVector_dict[*qdatavec],
1070d7b241e6Sjeremylt //             CeedVector_dict[*ustatevec], CeedVector_dict[*dustatevec],
1071d7b241e6Sjeremylt //             CeedVector_dict[*dresvec], &CeedRequest_dict[*rqst]);
1072d7b241e6Sjeremylt }
1073d7b241e6Sjeremylt 
1074d7b241e6Sjeremylt #define fCeedOperatorDestroy \
1075d7b241e6Sjeremylt     FORTRAN_NAME(ceedoperatordestroy, CEEDOPERATORDESTROY)
1076d7b241e6Sjeremylt void fCeedOperatorDestroy(int *op, int *err) {
1077d7b241e6Sjeremylt   *err = CeedOperatorDestroy(&CeedOperator_dict[*op]);
1078d7b241e6Sjeremylt   if (*err) return;
1079d7b241e6Sjeremylt   CeedOperator_n--;
1080d7b241e6Sjeremylt   if (CeedOperator_n == 0) {
1081d7b241e6Sjeremylt     *err = CeedFree(&CeedOperator_dict);
1082d7b241e6Sjeremylt     CeedOperator_count = 0;
1083d7b241e6Sjeremylt     CeedOperator_count_max = 0;
1084d7b241e6Sjeremylt   }
1085d7b241e6Sjeremylt }
1086