xref: /petsc/src/sys/objects/ftn-custom/zoptionsf.c (revision 84df9cb40eca90ea9b18a456fab7a4ecc7f6c1a4)
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 <private/fortranimpl.h>
8 
9 #ifdef PETSC_HAVE_FORTRAN_CAPS
10 #define petscoptionsgetbool_               PETSCOPTIONSGETBOOL
11 #define petscoptionsgetintarray_           PETSCOPTIONSGETINTARRAY
12 #define petscoptionssetvalue_              PETSCOPTIONSSETVALUE
13 #define petscoptionsclearvalue_            PETSCOPTIONSCLEARVALUE
14 #define petscoptionshasname_               PETSCOPTIONSHASNAME
15 #define petscoptionsgetint_                PETSCOPTIONSGETINT
16 #define petscoptionsgetreal_               PETSCOPTIONSGETREAL
17 #define petscoptionsgetrealarray_          PETSCOPTIONSGETREALARRAY
18 #define petscoptionsgetstring_             PETSCOPTIONSGETSTRING
19 #define petscgetprogramname                PETSCGETPROGRAMNAME
20 #define petscoptionsinsertfile_            PETSCOPTIONSINSERTFILE
21 #define petscoptionsclear_                 PETSCOPTIONSCLEAR
22 #define petscoptionsinsertstring_          PETSCOPTIONSINSERTSTRING
23 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
24 #define petscoptionsgetbool_               petscoptionsgetbool
25 #define petscoptionssetvalue_              petscoptionssetvalue
26 #define petscoptionsclearvalue_            petscoptionsclearvalue
27 #define petscoptionshasname_               petscoptionshasname
28 #define petscoptionsgetint_                petscoptionsgetint
29 #define petscoptionsgetreal_               petscoptionsgetreal
30 #define petscoptionsgetrealarray_          petscoptionsgetrealarray
31 #define petscoptionsgetstring_             petscoptionsgetstring
32 #define petscoptionsgetintarray_           petscoptionsgetintarray
33 #define petscgetprogramname_               petscgetprogramname
34 #define petscoptionsinsertfile_            petscoptionsinsertfile
35 #define petscoptionsclear_                 petscoptionsclear
36 #define petscoptionsinsertstring_          petscoptionsinsertstring
37 #endif
38 
39 EXTERN_C_BEGIN
40 
41 /* ---------------------------------------------------------------------*/
42 
43 void PETSC_STDCALL petscoptionsinsertstring_(CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
44 {
45   char *c1;
46 
47   FIXCHAR(file,len,c1);
48   *ierr = PetscOptionsInsertString(c1);
49   FREECHAR(file,c1);
50 }
51 
52 void PETSC_STDCALL petscoptionsinsertfile_(MPI_Fint *comm,CHAR file PETSC_MIXED_LEN(len),PetscBool  *require,PetscErrorCode *ierr PETSC_END_LEN(len))
53 {
54   char *c1;
55 
56   FIXCHAR(file,len,c1);
57   *ierr = PetscOptionsInsertFile(MPI_Comm_f2c(*comm),c1,*require);
58   FREECHAR(file,c1);
59 }
60 
61 void PETSC_STDCALL petscoptionssetvalue_(CHAR name PETSC_MIXED_LEN(len1),CHAR value PETSC_MIXED_LEN(len2),
62                    PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
63 {
64   char *c1,*c2;
65 
66   FIXCHAR(name,len1,c1);
67   FIXCHAR(value,len2,c2);
68   *ierr = PetscOptionsSetValue(c1,c2);
69   FREECHAR(name,c1);
70   FREECHAR(value,c2);
71 }
72 
73 void PETSC_STDCALL petscoptionsclear_(PetscErrorCode *ierr)
74 {
75   *ierr = PetscOptionsClear();
76 }
77 
78 void PETSC_STDCALL petscoptionsclearvalue_(CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
79 {
80   char *c1;
81 
82   FIXCHAR(name,len,c1);
83   *ierr = PetscOptionsClearValue(c1);
84   FREECHAR(name,c1);
85 }
86 
87 void PETSC_STDCALL petscoptionshasname_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2),
88                     PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
89 {
90   char *c1,*c2;
91 
92   FIXCHAR(pre,len1,c1);
93   FIXCHAR(name,len2,c2);
94   *ierr = PetscOptionsHasName(c1,c2,flg);
95   FREECHAR(pre,c1);
96   FREECHAR(name,c2);
97 }
98 
99 void PETSC_STDCALL petscoptionsgetint_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2),
100                     PetscInt *ivalue,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
101 {
102   char *c1,*c2;
103   PetscBool  flag;
104 
105   FIXCHAR(pre,len1,c1);
106   FIXCHAR(name,len2,c2);
107   *ierr = PetscOptionsGetInt(c1,c2,ivalue,&flag);
108   if (!FORTRANNULLTRUTH(flg)) *flg = flag;
109   FREECHAR(pre,c1);
110   FREECHAR(name,c2);
111 }
112 
113 void PETSC_STDCALL petscoptionsgetbool_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2),
114                     PetscBool  *ivalue,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
115 {
116   char *c1,*c2;
117   PetscBool  flag;
118 
119   FIXCHAR(pre,len1,c1);
120   FIXCHAR(name,len2,c2);
121   *ierr = PetscOptionsGetBool(c1,c2,ivalue,&flag);
122   if (!FORTRANNULLTRUTH(flg)) *flg = flag;
123   FREECHAR(pre,c1);
124   FREECHAR(name,c2);
125 }
126 
127 void PETSC_STDCALL petscoptionsgetreal_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2),
128                     PetscReal *dvalue,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   *ierr = PetscOptionsGetReal(c1,c2,dvalue,&flag);
136   if (!FORTRANNULLTRUTH(flg)) *flg = flag;
137   FREECHAR(pre,c1);
138   FREECHAR(name,c2);
139 }
140 
141 void PETSC_STDCALL petscoptionsgetrealarray_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2),
142                 PetscReal *dvalue,PetscInt *nmax,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
143 {
144   char *c1,*c2;
145   PetscBool  flag;
146 
147   FIXCHAR(pre,len1,c1);
148   FIXCHAR(name,len2,c2);
149   *ierr = PetscOptionsGetRealArray(c1,c2,dvalue,nmax,&flag);
150   if (!FORTRANNULLTRUTH(flg)) *flg = flag;
151   FREECHAR(pre,c1);
152   FREECHAR(name,c2);
153 }
154 
155 void PETSC_STDCALL petscoptionsgetintarray_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2),
156                    PetscInt *dvalue,PetscInt *nmax,PetscBool  *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
157 {
158   char *c1,*c2;
159   PetscBool  flag;
160 
161   FIXCHAR(pre,len1,c1);
162   FIXCHAR(name,len2,c2);
163   *ierr = PetscOptionsGetIntArray(c1,c2,dvalue,nmax,&flag);
164   if (!FORTRANNULLTRUTH(flg)) *flg = flag;
165   FREECHAR(pre,c1);
166   FREECHAR(name,c2);
167 }
168 
169 void PETSC_STDCALL petscoptionsgetstring_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2),
170                     CHAR string PETSC_MIXED_LEN(len),PetscBool  *flg,
171                     PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len))
172 {
173   char *c1,*c2,*c3;
174   size_t len3;
175   PetscBool  flag;
176 
177   FIXCHAR(pre,len1,c1);
178   FIXCHAR(name,len2,c2);
179   c3   = string;
180   len3 = len - 1;
181 
182   *ierr = PetscOptionsGetString(c1,c2,c3,len3,&flag);
183   if (!FORTRANNULLTRUTH(flg)) *flg = flag;
184   FREECHAR(pre,c1);
185   FREECHAR(name,c2);
186   FIXRETURNCHAR(flag,string,len);
187 }
188 
189 void PETSC_STDCALL petscgetprogramname_(CHAR name PETSC_MIXED_LEN(len_in),PetscErrorCode *ierr PETSC_END_LEN(len_in))
190 {
191   char *tmp;
192   size_t len;
193   tmp = name;
194   len = len_in - 1;
195   *ierr = PetscGetProgramName(tmp,len);
196   FIXRETURNCHAR(PETSC_TRUE,name,len_in);
197 }
198 
199 EXTERN_C_END
200 
201