xref: /petsc/src/sys/objects/ftn-custom/zoptionsf.c (revision 36a9e3b9f6565ce1252c167e0dc4a4cf71b0f2ec) 
1 /*
2   This file contains Fortran stubs for Options routines.
3   These are not generated automatically since they require passing strings
4   between Fortran and C.
5 */
6 
7 #include <petsc/private/fortranimpl.h>
8 #include <petscviewer.h>
9 
10 #if defined(PETSC_HAVE_FORTRAN_CAPS)
11 #define petscoptionsallused_               PETSCOPTIONSALLUSED
12 #define petscoptionsgetenumprivate_        PETSCOPTIONSGETENUMPRIVATE
13 #define petscoptionsgetbool_               PETSCOPTIONSGETBOOL
14 #define petscoptionsgetintarray_           PETSCOPTIONSGETINTARRAY
15 #define petscoptionssetvalue_              PETSCOPTIONSSETVALUE
16 #define petscoptionsclearvalue_            PETSCOPTIONSCLEARVALUE
17 #define petscoptionshasname_               PETSCOPTIONSHASNAME
18 #define petscoptionsgetint_                PETSCOPTIONSGETINT
19 #define petscoptionsgetreal_               PETSCOPTIONSGETREAL
20 #define petscoptionsgetscalar_             PETSCOPTIONSGETSCALAR
21 #define petscoptionsgetrealarray_          PETSCOPTIONSGETREALARRAY
22 #define petscoptionsgetstring_             PETSCOPTIONSGETSTRING
23 #define petscgetprogramname                PETSCGETPROGRAMNAME
24 #define petscoptionsinsertfile_            PETSCOPTIONSINSERTFILE
25 #define petscoptionsclear_                 PETSCOPTIONSCLEAR
26 #define petscoptionsinsertstring_          PETSCOPTIONSINSERTSTRING
27 #define petscoptionsview_                  PETSCOPTIONSVIEW
28 #define petscoptionsleft_                  PETSCOPTIONSLEFT
29 #define petscobjectviewfromoptions_        PETSCOBJECTVIEWFROMOPTIONS
30 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
31 #define petscoptionsallused_               petscoptionsallused
32 #define petscoptionsgetenumprivate_        petscoptionsgetenumprivate
33 #define petscoptionsgetbool_               petscoptionsgetbool
34 #define petscoptionssetvalue_              petscoptionssetvalue
35 #define petscoptionsclearvalue_            petscoptionsclearvalue
36 #define petscoptionshasname_               petscoptionshasname
37 #define petscoptionsgetint_                petscoptionsgetint
38 #define petscoptionsgetreal_               petscoptionsgetreal
39 #define petscoptionsgetscalar_             petscoptionsgetscalar
40 #define petscoptionsgetrealarray_          petscoptionsgetrealarray
41 #define petscoptionsgetstring_             petscoptionsgetstring
42 #define petscoptionsgetintarray_           petscoptionsgetintarray
43 #define petscgetprogramname_               petscgetprogramname
44 #define petscoptionsinsertfile_            petscoptionsinsertfile
45 #define petscoptionsclear_                 petscoptionsclear
46 #define petscoptionsinsertstring_          petscoptionsinsertstring
47 #define petscoptionsview_                  petscoptionsview
48 #define petscoptionsleft_                  petscoptionsleft
49 #define petscobjectviewfromoptions_        petscobjectviewfromoptions
50 #endif
51 
52 /* ---------------------------------------------------------------------*/
53 
54 PETSC_EXTERN void PETSC_STDCALL petscoptionsinsertstring_(PetscOptions *options,char* file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
55 {
56   char *c1;
57 
58   FIXCHAR(file,len,c1);
59   *ierr = PetscOptionsInsertString(*options,c1);if (*ierr) return;
60   FREECHAR(file,c1);
61 }
62 
63 PETSC_EXTERN void PETSC_STDCALL petscoptionsinsertfile_(MPI_Fint *comm,PetscOptions *options,char* file PETSC_MIXED_LEN(len),PetscBool *require,PetscErrorCode *ierr PETSC_END_LEN(len))
64 {
65   char *c1;
66 
67   FIXCHAR(file,len,c1);
68   *ierr = PetscOptionsInsertFile(MPI_Comm_f2c(*comm),*options,c1,*require);if (*ierr) return;
69   FREECHAR(file,c1);
70 }
71 
72 PETSC_EXTERN void PETSC_STDCALL petscoptionssetvalue_(PetscOptions *options,char* name PETSC_MIXED_LEN(len1),char* value PETSC_MIXED_LEN(len2),
73                    PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
74 {
75   char *c1,*c2;
76 
77   FIXCHAR(name,len1,c1);
78   FIXCHAR(value,len2,c2);
79   *ierr = PetscOptionsSetValue(*options,c1,c2);if (*ierr) return;
80   FREECHAR(name,c1);
81   FREECHAR(value,c2);
82 }
83 
84 PETSC_EXTERN void PETSC_STDCALL petscoptionsclear_(PetscOptions *options,PetscErrorCode *ierr)
85 {
86   *ierr = PetscOptionsClear(*options);
87 }
88 
89 PETSC_EXTERN void PETSC_STDCALL petscoptionsclearvalue_(PetscOptions *options,char* name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
90 {
91   char *c1;
92 
93   FIXCHAR(name,len,c1);
94   *ierr = PetscOptionsClearValue(*options,c1);if (*ierr) return;
95   FREECHAR(name,c1);
96 }
97 
98 PETSC_EXTERN void PETSC_STDCALL petscoptionshasname_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
99                     PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
100 {
101   char *c1,*c2;
102 
103   FIXCHAR(pre,len1,c1);
104   FIXCHAR(name,len2,c2);
105   *ierr = PetscOptionsHasName(*options,c1,c2,flg);if (*ierr) return;
106   FREECHAR(pre,c1);
107   FREECHAR(name,c2);
108 }
109 
110 
111 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetint_(PetscOptions *opt,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
112                     PetscInt *ivalue,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
113 {
114   char      *c1,*c2;
115   PetscBool flag;
116 
117   FIXCHAR(pre,len1,c1);
118   FIXCHAR(name,len2,c2);
119   *ierr = PetscOptionsGetInt(*opt,c1,c2,ivalue,&flag);if (*ierr) return;
120   if (!FORTRANNULLBOOL(flg)) *flg = flag;
121   FREECHAR(pre,c1);
122   FREECHAR(name,c2);
123 }
124 
125 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetenumprivate_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),const char *const*list,
126                     PetscEnum *ivalue,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
127 {
128   char      *c1,*c2;
129   PetscBool flag;
130 
131   FIXCHAR(pre,len1,c1);
132   FIXCHAR(name,len2,c2);
133   *ierr = PetscOptionsGetEnum(*options,c1,c2,list,ivalue,&flag);if (*ierr) return;
134   if (!FORTRANNULLBOOL(flg)) *flg = flag;
135   FREECHAR(pre,c1);
136   FREECHAR(name,c2);
137 }
138 
139 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetbool_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
140                     PetscBool  *ivalue,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
141 {
142   char      *c1,*c2;
143   PetscBool flag;
144 
145   FIXCHAR(pre,len1,c1);
146   FIXCHAR(name,len2,c2);
147   *ierr = PetscOptionsGetBool(*options,c1,c2,ivalue,&flag);if (*ierr) return;
148   if (!FORTRANNULLBOOL(flg)) *flg = flag;
149   FREECHAR(pre,c1);
150   FREECHAR(name,c2);
151 }
152 
153 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetreal_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
154                     PetscReal *dvalue,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
155 {
156   char *c1,*c2;
157   PetscBool  flag;
158 
159   FIXCHAR(pre,len1,c1);
160   FIXCHAR(name,len2,c2);
161   *ierr = PetscOptionsGetReal(*options,c1,c2,dvalue,&flag);if (*ierr) return;
162   if (!FORTRANNULLBOOL(flg)) *flg = flag;
163   FREECHAR(pre,c1);
164   FREECHAR(name,c2);
165 }
166 
167 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetscalar_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
168                     PetscScalar *dvalue,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
169 {
170   char *c1,*c2;
171   PetscBool  flag;
172 
173   FIXCHAR(pre,len1,c1);
174   FIXCHAR(name,len2,c2);
175   *ierr = PetscOptionsGetScalar(*options,c1,c2,dvalue,&flag);if (*ierr) return;
176   if (!FORTRANNULLBOOL(flg)) *flg = flag;
177   FREECHAR(pre,c1);
178   FREECHAR(name,c2);
179 }
180 
181 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetrealarray_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
182                 PetscReal *dvalue,PetscInt *nmax,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
183 {
184   char      *c1,*c2;
185   PetscBool flag;
186 
187   FIXCHAR(pre,len1,c1);
188   FIXCHAR(name,len2,c2);
189   *ierr = PetscOptionsGetRealArray(*options,c1,c2,dvalue,nmax,&flag);if (*ierr) return;
190   if (!FORTRANNULLBOOL(flg)) *flg = flag;
191   FREECHAR(pre,c1);
192   FREECHAR(name,c2);
193 }
194 
195 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetintarray_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
196                    PetscInt *dvalue,PetscInt *nmax,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
197 {
198   char      *c1,*c2;
199   PetscBool flag;
200 
201   FIXCHAR(pre,len1,c1);
202   FIXCHAR(name,len2,c2);
203   *ierr = PetscOptionsGetIntArray(*options,c1,c2,dvalue,nmax,&flag);if (*ierr) return;
204   if (!FORTRANNULLBOOL(flg)) *flg = flag;
205   FREECHAR(pre,c1);
206   FREECHAR(name,c2);
207 }
208 
209 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetstring_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
210                     char* string PETSC_MIXED_LEN(len),PetscBool  *flg,
211                     PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len))
212 {
213   char      *c1,*c2,*c3;
214   size_t    len3;
215   PetscBool flag;
216 
217   FIXCHAR(pre,len1,c1);
218   FIXCHAR(name,len2,c2);
219   c3   = string;
220   len3 = len - 1;
221 
222   *ierr = PetscOptionsGetString(*options,c1,c2,c3,len3,&flag);if (*ierr) return;
223   if (!FORTRANNULLBOOL(flg)) *flg = flag;
224   FREECHAR(pre,c1);
225   FREECHAR(name,c2);
226   FIXRETURNCHAR(flag,string,len);
227 }
228 
229 PETSC_EXTERN void PETSC_STDCALL petscgetprogramname_(char* name PETSC_MIXED_LEN(len_in),PetscErrorCode *ierr PETSC_END_LEN(len_in))
230 {
231   char   *tmp;
232   size_t len;
233   tmp   = name;
234   len   = len_in - 1;
235   *ierr = PetscGetProgramName(tmp,len);
236   FIXRETURNCHAR(PETSC_TRUE,name,len_in);
237 }
238 
239 PETSC_EXTERN void PETSC_STDCALL petscoptionsview_(PetscOptions *options,PetscViewer *vin,PetscErrorCode *ierr)
240 {
241   PetscViewer v;
242 
243   PetscPatchDefaultViewers_Fortran(vin,v);
244   *ierr = PetscOptionsView(*options,v);
245 }
246 
247 PETSC_EXTERN void PETSC_STDCALL petscobjectviewfromoptions_(PetscObject *obj,PetscObject *bobj,char* option PETSC_MIXED_LEN(loption),PetscErrorCode *ierr  PETSC_END_LEN(loption))
248 {
249   char *o;
250 
251   FIXCHAR(option, loption, o);
252   *ierr = PetscObjectViewFromOptions(*obj, *bobj, o);if (*ierr) return;
253   FREECHAR(option, o);
254 }
255