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 petscsubcommview_ PETSCSUBCOMMVIEW 12 #define petscsubcommgetparent_ PETSCSUBCOMMGETPARENT 13 #define petscsubcommgetcontiguousparent_ PETSCSUBCOMMGETCONTIGUOUSPARENT 14 #define petscsubcommgetchild_ PETSCSUBCOMMGETCHILD 15 #define petscoptionsallused_ PETSCOPTIONSALLUSED 16 #define petscoptionsgetenumprivate_ PETSCOPTIONSGETENUMPRIVATE 17 #define petscoptionsgetbool_ PETSCOPTIONSGETBOOL 18 #define petscoptionsgetboolarray_ PETSCOPTIONSGETBOOLARRAY 19 #define petscoptionsgetintarray_ PETSCOPTIONSGETINTARRAY 20 #define petscoptionssetvalue_ PETSCOPTIONSSETVALUE 21 #define petscoptionsclearvalue_ PETSCOPTIONSCLEARVALUE 22 #define petscoptionshasname_ PETSCOPTIONSHASNAME 23 #define petscoptionsgetint_ PETSCOPTIONSGETINT 24 #define petscoptionsgetreal_ PETSCOPTIONSGETREAL 25 #define petscoptionsgetscalar_ PETSCOPTIONSGETSCALAR 26 #define petscoptionsgetscalararray_ PETSCOPTIONSGETSCALARARRAY 27 #define petscoptionsgetrealarray_ PETSCOPTIONSGETREALARRAY 28 #define petscoptionsgetstring_ PETSCOPTIONSGETSTRING 29 #define petscgetprogramname PETSCGETPROGRAMNAME 30 #define petscoptionsinsertfile_ PETSCOPTIONSINSERTFILE 31 #define petscoptionsclear_ PETSCOPTIONSCLEAR 32 #define petscoptionsinsertstring_ PETSCOPTIONSINSERTSTRING 33 #define petscoptionsview_ PETSCOPTIONSVIEW 34 #define petscoptionsleft_ PETSCOPTIONSLEFT 35 #define petscobjectviewfromoptions_ PETSCOBJECTVIEWFROMOPTIONS 36 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 37 #define petscsubcommview_ petscsubcommview 38 #define petscsubcommgetparent_ petscsubcommgetparent 39 #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent 40 #define petscsubcommgetchild_ petscsubcommgetchild 41 #define petscoptionsallused_ petscoptionsallused 42 #define petscoptionsgetenumprivate_ petscoptionsgetenumprivate 43 #define petscoptionsgetbool_ petscoptionsgetbool 44 #define petscoptionsgetboolarray_ petscoptionsgetboolarray 45 #define petscoptionssetvalue_ petscoptionssetvalue 46 #define petscoptionsclearvalue_ petscoptionsclearvalue 47 #define petscoptionshasname_ petscoptionshasname 48 #define petscoptionsgetint_ petscoptionsgetint 49 #define petscoptionsgetreal_ petscoptionsgetreal 50 #define petscoptionsgetscalar_ petscoptionsgetscalar 51 #define petscoptionsgetscalararray_ petscoptionsgetscalararray 52 #define petscoptionsgetrealarray_ petscoptionsgetrealarray 53 #define petscoptionsgetstring_ petscoptionsgetstring 54 #define petscoptionsgetintarray_ petscoptionsgetintarray 55 #define petscgetprogramname_ petscgetprogramname 56 #define petscoptionsinsertfile_ petscoptionsinsertfile 57 #define petscoptionsclear_ petscoptionsclear 58 #define petscoptionsinsertstring_ petscoptionsinsertstring 59 #define petscoptionsview_ petscoptionsview 60 #define petscoptionsleft_ petscoptionsleft 61 #define petscobjectviewfromoptions_ petscobjectviewfromoptions 62 #endif 63 64 /* ---------------------------------------------------------------------*/ 65 66 PETSC_EXTERN void petscoptionsinsertstring_(PetscOptions *options,char* file,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 67 { 68 char *c1; 69 70 FIXCHAR(file,len,c1); 71 *ierr = PetscOptionsInsertString(*options,c1);if (*ierr) return; 72 FREECHAR(file,c1); 73 } 74 75 PETSC_EXTERN void petscoptionsinsertfile_(MPI_Fint *comm,PetscOptions *options,char* file,PetscBool *require,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 76 { 77 char *c1; 78 79 FIXCHAR(file,len,c1); 80 *ierr = PetscOptionsInsertFile(MPI_Comm_f2c(*comm),*options,c1,*require);if (*ierr) return; 81 FREECHAR(file,c1); 82 } 83 84 PETSC_EXTERN void petscoptionssetvalue_(PetscOptions *options,char* name,char* value, 85 PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 86 { 87 char *c1,*c2; 88 89 FIXCHAR(name,len1,c1); 90 FIXCHAR(value,len2,c2); 91 *ierr = PetscOptionsSetValue(*options,c1,c2);if (*ierr) return; 92 FREECHAR(name,c1); 93 FREECHAR(value,c2); 94 } 95 96 PETSC_EXTERN void petscoptionsclear_(PetscOptions *options,PetscErrorCode *ierr) 97 { 98 *ierr = PetscOptionsClear(*options); 99 } 100 101 PETSC_EXTERN void petscoptionsclearvalue_(PetscOptions *options,char* name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 102 { 103 char *c1; 104 105 FIXCHAR(name,len,c1); 106 *ierr = PetscOptionsClearValue(*options,c1);if (*ierr) return; 107 FREECHAR(name,c1); 108 } 109 110 PETSC_EXTERN void petscoptionshasname_(PetscOptions *options,char* pre,char* name, 111 PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 112 { 113 char *c1,*c2; 114 115 FIXCHAR(pre,len1,c1); 116 FIXCHAR(name,len2,c2); 117 *ierr = PetscOptionsHasName(*options,c1,c2,flg);if (*ierr) return; 118 FREECHAR(pre,c1); 119 FREECHAR(name,c2); 120 } 121 122 PETSC_EXTERN void petscoptionsgetint_(PetscOptions *opt,char* pre,char* name, 123 PetscInt *ivalue,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 124 { 125 char *c1,*c2; 126 PetscBool flag; 127 128 FIXCHAR(pre,len1,c1); 129 FIXCHAR(name,len2,c2); 130 *ierr = PetscOptionsGetInt(*opt,c1,c2,ivalue,&flag);if (*ierr) return; 131 if (!FORTRANNULLBOOL(flg)) *flg = flag; 132 FREECHAR(pre,c1); 133 FREECHAR(name,c2); 134 } 135 136 PETSC_EXTERN void petscoptionsgetenumprivate_(PetscOptions *options,char* pre,char* name,const char *const*list, 137 PetscEnum *ivalue,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 138 { 139 char *c1,*c2; 140 PetscBool flag; 141 142 FIXCHAR(pre,len1,c1); 143 FIXCHAR(name,len2,c2); 144 *ierr = PetscOptionsGetEnum(*options,c1,c2,list,ivalue,&flag);if (*ierr) return; 145 if (!FORTRANNULLBOOL(flg)) *flg = flag; 146 FREECHAR(pre,c1); 147 FREECHAR(name,c2); 148 } 149 150 PETSC_EXTERN void petscoptionsgetbool_(PetscOptions *options,char* pre,char* name, 151 PetscBool *ivalue,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 152 { 153 char *c1,*c2; 154 PetscBool flag; 155 156 FIXCHAR(pre,len1,c1); 157 FIXCHAR(name,len2,c2); 158 *ierr = PetscOptionsGetBool(*options,c1,c2,ivalue,&flag);if (*ierr) return; 159 if (!FORTRANNULLBOOL(flg)) *flg = flag; 160 FREECHAR(pre,c1); 161 FREECHAR(name,c2); 162 } 163 164 PETSC_EXTERN void petscoptionsgetboolarray_(PetscOptions *options,char* pre,char* name, 165 PetscBool *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 166 { 167 char *c1,*c2; 168 PetscBool flag; 169 170 FIXCHAR(pre,len1,c1); 171 FIXCHAR(name,len2,c2); 172 *ierr = PetscOptionsGetBoolArray(*options,c1,c2,dvalue,nmax,&flag);if (*ierr) return; 173 if (!FORTRANNULLBOOL(flg)) *flg = flag; 174 FREECHAR(pre,c1); 175 FREECHAR(name,c2); 176 } 177 178 PETSC_EXTERN void petscoptionsgetreal_(PetscOptions *options,char* pre,char* name, 179 PetscReal *dvalue,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 180 { 181 char *c1,*c2; 182 PetscBool flag; 183 184 FIXCHAR(pre,len1,c1); 185 FIXCHAR(name,len2,c2); 186 *ierr = PetscOptionsGetReal(*options,c1,c2,dvalue,&flag);if (*ierr) return; 187 if (!FORTRANNULLBOOL(flg)) *flg = flag; 188 FREECHAR(pre,c1); 189 FREECHAR(name,c2); 190 } 191 192 PETSC_EXTERN void petscoptionsgetscalar_(PetscOptions *options,char* pre,char* name, 193 PetscScalar *dvalue,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 194 { 195 char *c1,*c2; 196 PetscBool flag; 197 198 FIXCHAR(pre,len1,c1); 199 FIXCHAR(name,len2,c2); 200 *ierr = PetscOptionsGetScalar(*options,c1,c2,dvalue,&flag);if (*ierr) return; 201 if (!FORTRANNULLBOOL(flg)) *flg = flag; 202 FREECHAR(pre,c1); 203 FREECHAR(name,c2); 204 } 205 206 PETSC_EXTERN void petscoptionsgetscalararray_(PetscOptions *options,char* pre,char* name, 207 PetscScalar *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 208 { 209 char *c1,*c2; 210 PetscBool flag; 211 212 FIXCHAR(pre,len1,c1); 213 FIXCHAR(name,len2,c2); 214 *ierr = PetscOptionsGetScalarArray(*options,c1,c2,dvalue,nmax,&flag);if (*ierr) return; 215 if (!FORTRANNULLBOOL(flg)) *flg = flag; 216 FREECHAR(pre,c1); 217 FREECHAR(name,c2); 218 } 219 220 PETSC_EXTERN void petscoptionsgetrealarray_(PetscOptions *options,char* pre,char* name, 221 PetscReal *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 222 { 223 char *c1,*c2; 224 PetscBool flag; 225 226 FIXCHAR(pre,len1,c1); 227 FIXCHAR(name,len2,c2); 228 *ierr = PetscOptionsGetRealArray(*options,c1,c2,dvalue,nmax,&flag);if (*ierr) return; 229 if (!FORTRANNULLBOOL(flg)) *flg = flag; 230 FREECHAR(pre,c1); 231 FREECHAR(name,c2); 232 } 233 234 PETSC_EXTERN void petscoptionsgetintarray_(PetscOptions *options,char* pre,char* name, 235 PetscInt *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 236 { 237 char *c1,*c2; 238 PetscBool flag; 239 240 FIXCHAR(pre,len1,c1); 241 FIXCHAR(name,len2,c2); 242 *ierr = PetscOptionsGetIntArray(*options,c1,c2,dvalue,nmax,&flag);if (*ierr) return; 243 if (!FORTRANNULLBOOL(flg)) *flg = flag; 244 FREECHAR(pre,c1); 245 FREECHAR(name,c2); 246 } 247 248 PETSC_EXTERN void petscoptionsgetstring_(PetscOptions *options,char* pre,char* name, 249 char* string,PetscBool *flg, 250 PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2,PETSC_FORTRAN_CHARLEN_T len) 251 { 252 char *c1,*c2,*c3; 253 size_t len3; 254 PetscBool flag; 255 256 FIXCHAR(pre,len1,c1); 257 FIXCHAR(name,len2,c2); 258 c3 = string; 259 len3 = len - 1; 260 261 *ierr = PetscOptionsGetString(*options,c1,c2,c3,len3,&flag);if (*ierr) return; 262 if (!FORTRANNULLBOOL(flg)) *flg = flag; 263 FREECHAR(pre,c1); 264 FREECHAR(name,c2); 265 FIXRETURNCHAR(flag,string,len); 266 } 267 268 PETSC_EXTERN void petscgetprogramname_(char* name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len_in) 269 { 270 char *tmp; 271 size_t len; 272 tmp = name; 273 len = len_in - 1; 274 *ierr = PetscGetProgramName(tmp,len); 275 FIXRETURNCHAR(PETSC_TRUE,name,len_in); 276 } 277 278 PETSC_EXTERN void petscoptionsview_(PetscOptions *options,PetscViewer *vin,PetscErrorCode *ierr) 279 { 280 PetscViewer v; 281 282 PetscPatchDefaultViewers_Fortran(vin,v); 283 *ierr = PetscOptionsView(*options,v); 284 } 285 286 PETSC_EXTERN void petscobjectviewfromoptions_(PetscObject *obj,PetscObject *bobj,char* option,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T loption) 287 { 288 char *o; 289 290 FIXCHAR(option, loption, o); 291 CHKFORTRANNULLOBJECT(obj); 292 *ierr = PetscObjectViewFromOptions(*obj, *bobj, o);if (*ierr) return; 293 FREECHAR(option, o); 294 } 295 296 PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm,MPI_Fint *pcomm, int *ierr) 297 { 298 MPI_Comm tcomm; 299 *ierr = PetscSubcommGetParent(*scomm,&tcomm); 300 *pcomm = MPI_Comm_c2f(tcomm); 301 } 302 303 PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm,MPI_Fint *pcomm, int *ierr) 304 { 305 MPI_Comm tcomm; 306 *ierr = PetscSubcommGetContiguousParent(*scomm,&tcomm); 307 *pcomm = MPI_Comm_c2f(tcomm); 308 } 309 310 PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm,MPI_Fint *ccomm, int *ierr) 311 { 312 MPI_Comm tcomm; 313 *ierr = PetscSubcommGetChild(*scomm,&tcomm); 314 *ccomm = MPI_Comm_c2f(tcomm); 315 } 316 317 PETSC_EXTERN void petscsubcommview_(PetscSubcomm *psubcomm,PetscViewer *viewer, int *ierr) 318 { 319 PetscViewer v; 320 PetscPatchDefaultViewers_Fortran(viewer,v); 321 *ierr = PetscSubcommView(*psubcomm,v); 322 } 323