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