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