xref: /petsc/src/sys/objects/ftn-custom/zoptionsf.c (revision feff33ee0b5b037fa8f9f294dede656a2f85cc47) 
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   CHKFORTRANNULLOBJECTDEREFERENCE(options);
60   *ierr = PetscOptionsInsertString(*options,c1);
61   FREECHAR(file,c1);
62 }
63 
64 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))
65 {
66   char *c1;
67 
68   FIXCHAR(file,len,c1);
69   CHKFORTRANNULLOBJECTDEREFERENCE(options);
70   *ierr = PetscOptionsInsertFile(MPI_Comm_f2c(*comm),*options,c1,*require);
71   FREECHAR(file,c1);
72 }
73 
74 PETSC_EXTERN void PETSC_STDCALL petscoptionssetvalue_(PetscOptions *options,char* name PETSC_MIXED_LEN(len1),char* value PETSC_MIXED_LEN(len2),
75                    PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
76 {
77   char *c1,*c2;
78 
79   FIXCHAR(name,len1,c1);
80   FIXCHAR(value,len2,c2);
81   CHKFORTRANNULLOBJECTDEREFERENCE(options);
82   *ierr = PetscOptionsSetValue(*options,c1,c2);
83   FREECHAR(name,c1);
84   FREECHAR(value,c2);
85 }
86 
87 PETSC_EXTERN void PETSC_STDCALL petscoptionsclear_(PetscOptions *options,PetscErrorCode *ierr)
88 {
89   CHKFORTRANNULLOBJECTDEREFERENCE(options);
90   *ierr = PetscOptionsClear(*options);
91 }
92 
93 PETSC_EXTERN void PETSC_STDCALL petscoptionsclearvalue_(PetscOptions *options,char* name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
94 {
95   char *c1;
96 
97   FIXCHAR(name,len,c1);
98   CHKFORTRANNULLOBJECTDEREFERENCE(options);
99   *ierr = PetscOptionsClearValue(*options,c1);
100   FREECHAR(name,c1);
101 }
102 
103 PETSC_EXTERN void PETSC_STDCALL petscoptionshasname_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
104                     PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
105 {
106   char *c1,*c2;
107 
108   FIXCHAR(pre,len1,c1);
109   FIXCHAR(name,len2,c2);
110   CHKFORTRANNULLOBJECTDEREFERENCE(options);
111   *ierr = PetscOptionsHasName(*options,c1,c2,flg);
112   FREECHAR(pre,c1);
113   FREECHAR(name,c2);
114 }
115 
116 PETSC_EXTERN void PETSC_STDCALL petscoptionsallused_(PetscOptions *opt,PetscInt *n,PetscErrorCode *ierr)
117 {
118   CHKFORTRANNULLOBJECTDEREFERENCE(opt);
119   *ierr = PetscOptionsAllUsed(*opt,n);
120 }
121 
122 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetint_(PetscOptions *opt,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
123                     PetscInt *ivalue,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
124 {
125   char      *c1,*c2;
126   PetscBool flag;
127 
128   FIXCHAR(pre,len1,c1);
129   FIXCHAR(name,len2,c2);
130   CHKFORTRANNULLOBJECTDEREFERENCE(opt);
131   *ierr = PetscOptionsGetInt(*opt,c1,c2,ivalue,&flag);
132   if (!FORTRANNULLBOOL(flg)) *flg = flag;
133   FREECHAR(pre,c1);
134   FREECHAR(name,c2);
135 }
136 
137 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetenumprivate_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),const char *const*list,
138                     PetscEnum *ivalue,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
139 {
140   char      *c1,*c2;
141   PetscBool flag;
142 
143   FIXCHAR(pre,len1,c1);
144   FIXCHAR(name,len2,c2);
145   CHKFORTRANNULLOBJECTDEREFERENCE(options);
146   *ierr = PetscOptionsGetEnum(*options,c1,c2,list,ivalue,&flag);
147   if (!FORTRANNULLBOOL(flg)) *flg = flag;
148   FREECHAR(pre,c1);
149   FREECHAR(name,c2);
150 }
151 
152 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetbool_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
153                     PetscBool  *ivalue,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
154 {
155   char      *c1,*c2;
156   PetscBool flag;
157 
158   FIXCHAR(pre,len1,c1);
159   FIXCHAR(name,len2,c2);
160   CHKFORTRANNULLOBJECTDEREFERENCE(options);
161   *ierr = PetscOptionsGetBool(*options,c1,c2,ivalue,&flag);
162   if (!FORTRANNULLBOOL(flg)) *flg = flag;
163   FREECHAR(pre,c1);
164   FREECHAR(name,c2);
165 }
166 
167 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetreal_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
168                     PetscReal *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   CHKFORTRANNULLOBJECTDEREFERENCE(options);
176   *ierr = PetscOptionsGetReal(*options,c1,c2,dvalue,&flag);
177   if (!FORTRANNULLBOOL(flg)) *flg = flag;
178   FREECHAR(pre,c1);
179   FREECHAR(name,c2);
180 }
181 
182 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetscalar_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
183                     PetscScalar *dvalue,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
184 {
185   char *c1,*c2;
186   PetscBool  flag;
187 
188   FIXCHAR(pre,len1,c1);
189   FIXCHAR(name,len2,c2);
190   CHKFORTRANNULLOBJECTDEREFERENCE(options);
191   *ierr = PetscOptionsGetScalar(*options,c1,c2,dvalue,&flag);
192   if (!FORTRANNULLBOOL(flg)) *flg = flag;
193   FREECHAR(pre,c1);
194   FREECHAR(name,c2);
195 }
196 
197 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetrealarray_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
198                 PetscReal *dvalue,PetscInt *nmax,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
199 {
200   char      *c1,*c2;
201   PetscBool flag;
202 
203   FIXCHAR(pre,len1,c1);
204   FIXCHAR(name,len2,c2);
205   CHKFORTRANNULLOBJECTDEREFERENCE(options);
206   *ierr = PetscOptionsGetRealArray(*options,c1,c2,dvalue,nmax,&flag);
207   if (!FORTRANNULLBOOL(flg)) *flg = flag;
208   FREECHAR(pre,c1);
209   FREECHAR(name,c2);
210 }
211 
212 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetintarray_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
213                    PetscInt *dvalue,PetscInt *nmax,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
214 {
215   char      *c1,*c2;
216   PetscBool flag;
217 
218   FIXCHAR(pre,len1,c1);
219   FIXCHAR(name,len2,c2);
220   CHKFORTRANNULLOBJECTDEREFERENCE(options);
221   *ierr = PetscOptionsGetIntArray(*options,c1,c2,dvalue,nmax,&flag);
222   if (!FORTRANNULLBOOL(flg)) *flg = flag;
223   FREECHAR(pre,c1);
224   FREECHAR(name,c2);
225 }
226 
227 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetstring_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),
228                     char* string PETSC_MIXED_LEN(len),PetscBool  *flg,
229                     PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len))
230 {
231   char      *c1,*c2,*c3;
232   size_t    len3;
233   PetscBool flag;
234 
235   FIXCHAR(pre,len1,c1);
236   FIXCHAR(name,len2,c2);
237   c3   = string;
238   len3 = len - 1;
239 
240   CHKFORTRANNULLOBJECTDEREFERENCE(options);
241   *ierr = PetscOptionsGetString(*options,c1,c2,c3,len3,&flag);
242   if (!FORTRANNULLBOOL(flg)) *flg = flag;
243   FREECHAR(pre,c1);
244   FREECHAR(name,c2);
245   FIXRETURNCHAR(flag,string,len);
246 }
247 
248 PETSC_EXTERN void PETSC_STDCALL petscgetprogramname_(char* name PETSC_MIXED_LEN(len_in),PetscErrorCode *ierr PETSC_END_LEN(len_in))
249 {
250   char   *tmp;
251   size_t len;
252   tmp   = name;
253   len   = len_in - 1;
254   *ierr = PetscGetProgramName(tmp,len);
255   FIXRETURNCHAR(PETSC_TRUE,name,len_in);
256 }
257 
258 PETSC_EXTERN void PETSC_STDCALL petscoptionsview_(PetscOptions *options,PetscViewer *vin,PetscErrorCode *ierr)
259 {
260   PetscViewer v;
261 
262   PetscPatchDefaultViewers_Fortran(vin,v);
263   CHKFORTRANNULLOBJECTDEREFERENCE(options);
264   *ierr = PetscOptionsView(*options,v);
265 }
266 
267 PETSC_EXTERN void PETSC_STDCALL petscoptionsleft_(PetscOptions *options,PetscErrorCode *ierr)
268 {
269   CHKFORTRANNULLOBJECTDEREFERENCE(options);
270   *ierr = PetscOptionsLeft(*options);
271 }
272 
273 
274 PETSC_EXTERN void PETSC_STDCALL petscobjectviewfromoptions_(PetscObject *obj,PetscObject *bobj,char* option PETSC_MIXED_LEN(loption),PetscErrorCode *ierr  PETSC_END_LEN(loption))
275 {
276   char *o;
277 
278   FIXCHAR(option, loption, o);
279   CHKFORTRANNULLOBJECTDEREFERENCE(bobj);
280   *ierr = PetscObjectViewFromOptions(*obj, *bobj, o);
281   FREECHAR(option, o);
282 }
283