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 *ierr = PetscOptionsInsertString(*options,c1); 60 FREECHAR(file,c1); 61 } 62 63 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)) 64 { 65 char *c1; 66 67 FIXCHAR(file,len,c1); 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 *ierr = PetscOptionsSetValue(*options,c1,c2); 80 FREECHAR(name,c1); 81 FREECHAR(value,c2); 82 } 83 84 PETSC_EXTERN void PETSC_STDCALL petscoptionsclear_(PetscOptions *options,PetscErrorCode *ierr) 85 { 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 *ierr = PetscOptionsClearValue(*options,c1); 95 FREECHAR(name,c1); 96 } 97 98 PETSC_EXTERN void PETSC_STDCALL petscoptionshasname_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2), 99 PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 100 { 101 char *c1,*c2; 102 103 FIXCHAR(pre,len1,c1); 104 FIXCHAR(name,len2,c2); 105 *ierr = PetscOptionsHasName(*options,c1,c2,flg); 106 FREECHAR(pre,c1); 107 FREECHAR(name,c2); 108 } 109 110 111 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetint_(PetscOptions *opt,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2), 112 PetscInt *ivalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 113 { 114 char *c1,*c2; 115 PetscBool flag; 116 117 FIXCHAR(pre,len1,c1); 118 FIXCHAR(name,len2,c2); 119 *ierr = PetscOptionsGetInt(*opt,c1,c2,ivalue,&flag); 120 if (!FORTRANNULLBOOL(flg)) *flg = flag; 121 FREECHAR(pre,c1); 122 FREECHAR(name,c2); 123 } 124 125 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetenumprivate_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2),const char *const*list, 126 PetscEnum *ivalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 127 { 128 char *c1,*c2; 129 PetscBool flag; 130 131 FIXCHAR(pre,len1,c1); 132 FIXCHAR(name,len2,c2); 133 *ierr = PetscOptionsGetEnum(*options,c1,c2,list,ivalue,&flag); 134 if (!FORTRANNULLBOOL(flg)) *flg = flag; 135 FREECHAR(pre,c1); 136 FREECHAR(name,c2); 137 } 138 139 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetbool_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2), 140 PetscBool *ivalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 141 { 142 char *c1,*c2; 143 PetscBool flag; 144 145 FIXCHAR(pre,len1,c1); 146 FIXCHAR(name,len2,c2); 147 *ierr = PetscOptionsGetBool(*options,c1,c2,ivalue,&flag); 148 if (!FORTRANNULLBOOL(flg)) *flg = flag; 149 FREECHAR(pre,c1); 150 FREECHAR(name,c2); 151 } 152 153 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetreal_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2), 154 PetscReal *dvalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 155 { 156 char *c1,*c2; 157 PetscBool flag; 158 159 FIXCHAR(pre,len1,c1); 160 FIXCHAR(name,len2,c2); 161 *ierr = PetscOptionsGetReal(*options,c1,c2,dvalue,&flag); 162 if (!FORTRANNULLBOOL(flg)) *flg = flag; 163 FREECHAR(pre,c1); 164 FREECHAR(name,c2); 165 } 166 167 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetscalar_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2), 168 PetscScalar *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 *ierr = PetscOptionsGetScalar(*options,c1,c2,dvalue,&flag); 176 if (!FORTRANNULLBOOL(flg)) *flg = flag; 177 FREECHAR(pre,c1); 178 FREECHAR(name,c2); 179 } 180 181 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetrealarray_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2), 182 PetscReal *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 183 { 184 char *c1,*c2; 185 PetscBool flag; 186 187 FIXCHAR(pre,len1,c1); 188 FIXCHAR(name,len2,c2); 189 *ierr = PetscOptionsGetRealArray(*options,c1,c2,dvalue,nmax,&flag); 190 if (!FORTRANNULLBOOL(flg)) *flg = flag; 191 FREECHAR(pre,c1); 192 FREECHAR(name,c2); 193 } 194 195 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetintarray_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2), 196 PetscInt *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 197 { 198 char *c1,*c2; 199 PetscBool flag; 200 201 FIXCHAR(pre,len1,c1); 202 FIXCHAR(name,len2,c2); 203 *ierr = PetscOptionsGetIntArray(*options,c1,c2,dvalue,nmax,&flag); 204 if (!FORTRANNULLBOOL(flg)) *flg = flag; 205 FREECHAR(pre,c1); 206 FREECHAR(name,c2); 207 } 208 209 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetstring_(PetscOptions *options,char* pre PETSC_MIXED_LEN(len1),char* name PETSC_MIXED_LEN(len2), 210 char* string PETSC_MIXED_LEN(len),PetscBool *flg, 211 PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len)) 212 { 213 char *c1,*c2,*c3; 214 size_t len3; 215 PetscBool flag; 216 217 FIXCHAR(pre,len1,c1); 218 FIXCHAR(name,len2,c2); 219 c3 = string; 220 len3 = len - 1; 221 222 *ierr = PetscOptionsGetString(*options,c1,c2,c3,len3,&flag); 223 if (!FORTRANNULLBOOL(flg)) *flg = flag; 224 FREECHAR(pre,c1); 225 FREECHAR(name,c2); 226 FIXRETURNCHAR(flag,string,len); 227 } 228 229 PETSC_EXTERN void PETSC_STDCALL petscgetprogramname_(char* name PETSC_MIXED_LEN(len_in),PetscErrorCode *ierr PETSC_END_LEN(len_in)) 230 { 231 char *tmp; 232 size_t len; 233 tmp = name; 234 len = len_in - 1; 235 *ierr = PetscGetProgramName(tmp,len); 236 FIXRETURNCHAR(PETSC_TRUE,name,len_in); 237 } 238 239 PETSC_EXTERN void PETSC_STDCALL petscoptionsview_(PetscOptions *options,PetscViewer *vin,PetscErrorCode *ierr) 240 { 241 PetscViewer v; 242 243 PetscPatchDefaultViewers_Fortran(vin,v); 244 *ierr = PetscOptionsView(*options,v); 245 } 246 247 PETSC_EXTERN void PETSC_STDCALL petscobjectviewfromoptions_(PetscObject *obj,PetscObject *bobj,char* option PETSC_MIXED_LEN(loption),PetscErrorCode *ierr PETSC_END_LEN(loption)) 248 { 249 char *o; 250 251 FIXCHAR(option, loption, o); 252 *ierr = PetscObjectViewFromOptions(*obj, *bobj, o); 253 FREECHAR(option, o); 254 } 255