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 PETSC_EXTERN void petscoptionsgetint_(PetscOptions *opt,char* pre,char* name, 119 PetscInt *ivalue,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 120 { 121 char *c1,*c2; 122 PetscBool flag; 123 124 FIXCHAR(pre,len1,c1); 125 FIXCHAR(name,len2,c2); 126 *ierr = PetscOptionsGetInt(*opt,c1,c2,ivalue,&flag);if (*ierr) return; 127 if (!FORTRANNULLBOOL(flg)) *flg = flag; 128 FREECHAR(pre,c1); 129 FREECHAR(name,c2); 130 } 131 132 PETSC_EXTERN void petscoptionsgetenumprivate_(PetscOptions *options,char* pre,char* name,const char *const*list, 133 PetscEnum *ivalue,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 134 { 135 char *c1,*c2; 136 PetscBool flag; 137 138 FIXCHAR(pre,len1,c1); 139 FIXCHAR(name,len2,c2); 140 *ierr = PetscOptionsGetEnum(*options,c1,c2,list,ivalue,&flag);if (*ierr) return; 141 if (!FORTRANNULLBOOL(flg)) *flg = flag; 142 FREECHAR(pre,c1); 143 FREECHAR(name,c2); 144 } 145 146 PETSC_EXTERN void petscoptionsgetbool_(PetscOptions *options,char* pre,char* name, 147 PetscBool *ivalue,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 148 { 149 char *c1,*c2; 150 PetscBool flag; 151 152 FIXCHAR(pre,len1,c1); 153 FIXCHAR(name,len2,c2); 154 *ierr = PetscOptionsGetBool(*options,c1,c2,ivalue,&flag);if (*ierr) return; 155 if (!FORTRANNULLBOOL(flg)) *flg = flag; 156 FREECHAR(pre,c1); 157 FREECHAR(name,c2); 158 } 159 160 PETSC_EXTERN void petscoptionsgetreal_(PetscOptions *options,char* pre,char* name, 161 PetscReal *dvalue,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 162 { 163 char *c1,*c2; 164 PetscBool flag; 165 166 FIXCHAR(pre,len1,c1); 167 FIXCHAR(name,len2,c2); 168 *ierr = PetscOptionsGetReal(*options,c1,c2,dvalue,&flag);if (*ierr) return; 169 if (!FORTRANNULLBOOL(flg)) *flg = flag; 170 FREECHAR(pre,c1); 171 FREECHAR(name,c2); 172 } 173 174 PETSC_EXTERN void petscoptionsgetscalar_(PetscOptions *options,char* pre,char* name, 175 PetscScalar *dvalue,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 176 { 177 char *c1,*c2; 178 PetscBool flag; 179 180 FIXCHAR(pre,len1,c1); 181 FIXCHAR(name,len2,c2); 182 *ierr = PetscOptionsGetScalar(*options,c1,c2,dvalue,&flag);if (*ierr) return; 183 if (!FORTRANNULLBOOL(flg)) *flg = flag; 184 FREECHAR(pre,c1); 185 FREECHAR(name,c2); 186 } 187 188 PETSC_EXTERN void petscoptionsgetrealarray_(PetscOptions *options,char* pre,char* name, 189 PetscReal *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 190 { 191 char *c1,*c2; 192 PetscBool flag; 193 194 FIXCHAR(pre,len1,c1); 195 FIXCHAR(name,len2,c2); 196 *ierr = PetscOptionsGetRealArray(*options,c1,c2,dvalue,nmax,&flag);if (*ierr) return; 197 if (!FORTRANNULLBOOL(flg)) *flg = flag; 198 FREECHAR(pre,c1); 199 FREECHAR(name,c2); 200 } 201 202 PETSC_EXTERN void petscoptionsgetintarray_(PetscOptions *options,char* pre,char* name, 203 PetscInt *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2) 204 { 205 char *c1,*c2; 206 PetscBool flag; 207 208 FIXCHAR(pre,len1,c1); 209 FIXCHAR(name,len2,c2); 210 *ierr = PetscOptionsGetIntArray(*options,c1,c2,dvalue,nmax,&flag);if (*ierr) return; 211 if (!FORTRANNULLBOOL(flg)) *flg = flag; 212 FREECHAR(pre,c1); 213 FREECHAR(name,c2); 214 } 215 216 PETSC_EXTERN void petscoptionsgetstring_(PetscOptions *options,char* pre,char* name, 217 char* string,PetscBool *flg, 218 PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2,PETSC_FORTRAN_CHARLEN_T len) 219 { 220 char *c1,*c2,*c3; 221 size_t len3; 222 PetscBool flag; 223 224 FIXCHAR(pre,len1,c1); 225 FIXCHAR(name,len2,c2); 226 c3 = string; 227 len3 = len - 1; 228 229 *ierr = PetscOptionsGetString(*options,c1,c2,c3,len3,&flag);if (*ierr) return; 230 if (!FORTRANNULLBOOL(flg)) *flg = flag; 231 FREECHAR(pre,c1); 232 FREECHAR(name,c2); 233 FIXRETURNCHAR(flag,string,len); 234 } 235 236 PETSC_EXTERN void petscgetprogramname_(char* name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len_in) 237 { 238 char *tmp; 239 size_t len; 240 tmp = name; 241 len = len_in - 1; 242 *ierr = PetscGetProgramName(tmp,len); 243 FIXRETURNCHAR(PETSC_TRUE,name,len_in); 244 } 245 246 PETSC_EXTERN void petscoptionsview_(PetscOptions *options,PetscViewer *vin,PetscErrorCode *ierr) 247 { 248 PetscViewer v; 249 250 PetscPatchDefaultViewers_Fortran(vin,v); 251 *ierr = PetscOptionsView(*options,v); 252 } 253 254 PETSC_EXTERN void petscobjectviewfromoptions_(PetscObject *obj,PetscObject *bobj,char* option,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T loption) 255 { 256 char *o; 257 258 FIXCHAR(option, loption, o); 259 CHKFORTRANNULLOBJECT(obj); 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