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_(CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 49 { 50 char *c1; 51 52 FIXCHAR(file,len,c1); 53 *ierr = PetscOptionsInsertString(c1); 54 FREECHAR(file,c1); 55 } 56 57 PETSC_EXTERN void PETSC_STDCALL petscoptionsinsertfile_(MPI_Fint *comm,CHAR file PETSC_MIXED_LEN(len),PetscBool *require,PetscErrorCode *ierr PETSC_END_LEN(len)) 58 { 59 char *c1; 60 61 FIXCHAR(file,len,c1); 62 *ierr = PetscOptionsInsertFile(MPI_Comm_f2c(*comm),c1,*require); 63 FREECHAR(file,c1); 64 } 65 66 PETSC_EXTERN void PETSC_STDCALL petscoptionssetvalue_(CHAR name PETSC_MIXED_LEN(len1),CHAR value PETSC_MIXED_LEN(len2), 67 PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 68 { 69 char *c1,*c2; 70 71 FIXCHAR(name,len1,c1); 72 FIXCHAR(value,len2,c2); 73 *ierr = PetscOptionsSetValue(c1,c2); 74 FREECHAR(name,c1); 75 FREECHAR(value,c2); 76 } 77 78 PETSC_EXTERN void PETSC_STDCALL petscoptionsclear_(PetscErrorCode *ierr) 79 { 80 *ierr = PetscOptionsClear(); 81 } 82 83 PETSC_EXTERN void PETSC_STDCALL petscoptionsclearvalue_(CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 84 { 85 char *c1; 86 87 FIXCHAR(name,len,c1); 88 *ierr = PetscOptionsClearValue(c1); 89 FREECHAR(name,c1); 90 } 91 92 PETSC_EXTERN void PETSC_STDCALL petscoptionshasname_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 93 PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 94 { 95 char *c1,*c2; 96 97 FIXCHAR(pre,len1,c1); 98 FIXCHAR(name,len2,c2); 99 *ierr = PetscOptionsHasName(c1,c2,flg); 100 FREECHAR(pre,c1); 101 FREECHAR(name,c2); 102 } 103 104 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetint_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 105 PetscInt *ivalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 106 { 107 char *c1,*c2; 108 PetscBool flag; 109 110 FIXCHAR(pre,len1,c1); 111 FIXCHAR(name,len2,c2); 112 *ierr = PetscOptionsGetInt(c1,c2,ivalue,&flag); 113 if (!FORTRANNULLBOOL(flg)) *flg = flag; 114 FREECHAR(pre,c1); 115 FREECHAR(name,c2); 116 } 117 118 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetenumprivate_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2),const char *const*list, 119 PetscEnum *ivalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 120 { 121 char *c1,*c2; 122 PetscBool flag; 123 124 FIXCHAR(pre,len1,c1); 125 FIXCHAR(name,len2,c2); 126 *ierr = PetscOptionsGetEnum(c1,c2,list,ivalue,&flag); 127 if (!FORTRANNULLBOOL(flg)) *flg = flag; 128 FREECHAR(pre,c1); 129 FREECHAR(name,c2); 130 } 131 132 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetbool_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 133 PetscBool *ivalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 134 { 135 char *c1,*c2; 136 PetscBool flag; 137 138 FIXCHAR(pre,len1,c1); 139 FIXCHAR(name,len2,c2); 140 *ierr = PetscOptionsGetBool(c1,c2,ivalue,&flag); 141 if (!FORTRANNULLBOOL(flg)) *flg = flag; 142 FREECHAR(pre,c1); 143 FREECHAR(name,c2); 144 } 145 146 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetreal_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 147 PetscReal *dvalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 148 { 149 char *c1,*c2; 150 PetscBool flag; 151 152 FIXCHAR(pre,len1,c1); 153 FIXCHAR(name,len2,c2); 154 *ierr = PetscOptionsGetReal(c1,c2,dvalue,&flag); 155 if (!FORTRANNULLBOOL(flg)) *flg = flag; 156 FREECHAR(pre,c1); 157 FREECHAR(name,c2); 158 } 159 160 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetrealarray_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 161 PetscReal *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 162 { 163 char *c1,*c2; 164 PetscBool flag; 165 166 FIXCHAR(pre,len1,c1); 167 FIXCHAR(name,len2,c2); 168 *ierr = PetscOptionsGetRealArray(c1,c2,dvalue,nmax,&flag); 169 if (!FORTRANNULLBOOL(flg)) *flg = flag; 170 FREECHAR(pre,c1); 171 FREECHAR(name,c2); 172 } 173 174 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetintarray_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 175 PetscInt *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 176 { 177 char *c1,*c2; 178 PetscBool flag; 179 180 FIXCHAR(pre,len1,c1); 181 FIXCHAR(name,len2,c2); 182 *ierr = PetscOptionsGetIntArray(c1,c2,dvalue,nmax,&flag); 183 if (!FORTRANNULLBOOL(flg)) *flg = flag; 184 FREECHAR(pre,c1); 185 FREECHAR(name,c2); 186 } 187 188 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetstring_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 189 CHAR string PETSC_MIXED_LEN(len),PetscBool *flg, 190 PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len)) 191 { 192 char *c1,*c2,*c3; 193 size_t len3; 194 PetscBool flag; 195 196 FIXCHAR(pre,len1,c1); 197 FIXCHAR(name,len2,c2); 198 c3 = string; 199 len3 = len - 1; 200 201 *ierr = PetscOptionsGetString(c1,c2,c3,len3,&flag); 202 if (!FORTRANNULLBOOL(flg)) *flg = flag; 203 FREECHAR(pre,c1); 204 FREECHAR(name,c2); 205 FIXRETURNCHAR(flag,string,len); 206 } 207 208 PETSC_EXTERN void PETSC_STDCALL petscgetprogramname_(CHAR name PETSC_MIXED_LEN(len_in),PetscErrorCode *ierr PETSC_END_LEN(len_in)) 209 { 210 char *tmp; 211 size_t len; 212 tmp = name; 213 len = len_in - 1; 214 *ierr = PetscGetProgramName(tmp,len); 215 FIXRETURNCHAR(PETSC_TRUE,name,len_in); 216 } 217 218 PETSC_EXTERN void PETSC_STDCALL petscoptionsview_(PetscViewer *vin,PetscErrorCode *ierr) 219 { 220 PetscViewer v; 221 222 PetscPatchDefaultViewers_Fortran(vin,v); 223 *ierr = PetscOptionsView(v); 224 } 225 226 PETSC_EXTERN void PETSC_STDCALL petscobjectviewfromoptions_(PetscObject *obj,CHAR prefix PETSC_MIXED_LEN(lprefix),CHAR option PETSC_MIXED_LEN(loption),PetscErrorCode *ierr PETSC_END_LEN(lprefix) PETSC_END_LEN(loption)) 227 { 228 char *p, *o; 229 230 FIXCHAR(prefix, lprefix, p); 231 FIXCHAR(option, loption, o); 232 *ierr = PetscObjectViewFromOptions(*obj, p, o); 233 FREECHAR(prefix, p); 234 FREECHAR(option, o); 235 } 236