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