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