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