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