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 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 27 #define petscoptionsgetenumprivate_ petscoptionsgetenumprivate 28 #define petscoptionsgetbool_ petscoptionsgetbool 29 #define petscoptionssetvalue_ petscoptionssetvalue 30 #define petscoptionsclearvalue_ petscoptionsclearvalue 31 #define petscoptionshasname_ petscoptionshasname 32 #define petscoptionsgetint_ petscoptionsgetint 33 #define petscoptionsgetreal_ petscoptionsgetreal 34 #define petscoptionsgetrealarray_ petscoptionsgetrealarray 35 #define petscoptionsgetstring_ petscoptionsgetstring 36 #define petscoptionsgetintarray_ petscoptionsgetintarray 37 #define petscgetprogramname_ petscgetprogramname 38 #define petscoptionsinsertfile_ petscoptionsinsertfile 39 #define petscoptionsclear_ petscoptionsclear 40 #define petscoptionsinsertstring_ petscoptionsinsertstring 41 #define petscoptionsview_ petscoptionsview 42 #endif 43 44 /* ---------------------------------------------------------------------*/ 45 46 PETSC_EXTERN void PETSC_STDCALL petscoptionsinsertstring_(CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 47 { 48 char *c1; 49 50 FIXCHAR(file,len,c1); 51 *ierr = PetscOptionsInsertString(c1); 52 FREECHAR(file,c1); 53 } 54 55 PETSC_EXTERN void PETSC_STDCALL petscoptionsinsertfile_(MPI_Fint *comm,CHAR file PETSC_MIXED_LEN(len),PetscBool *require,PetscErrorCode *ierr PETSC_END_LEN(len)) 56 { 57 char *c1; 58 59 FIXCHAR(file,len,c1); 60 *ierr = PetscOptionsInsertFile(MPI_Comm_f2c(*comm),c1,*require); 61 FREECHAR(file,c1); 62 } 63 64 PETSC_EXTERN void PETSC_STDCALL petscoptionssetvalue_(CHAR name PETSC_MIXED_LEN(len1),CHAR value PETSC_MIXED_LEN(len2), 65 PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 66 { 67 char *c1,*c2; 68 69 FIXCHAR(name,len1,c1); 70 FIXCHAR(value,len2,c2); 71 *ierr = PetscOptionsSetValue(c1,c2); 72 FREECHAR(name,c1); 73 FREECHAR(value,c2); 74 } 75 76 PETSC_EXTERN void PETSC_STDCALL petscoptionsclear_(PetscErrorCode *ierr) 77 { 78 *ierr = PetscOptionsClear(); 79 } 80 81 PETSC_EXTERN void PETSC_STDCALL petscoptionsclearvalue_(CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 82 { 83 char *c1; 84 85 FIXCHAR(name,len,c1); 86 *ierr = PetscOptionsClearValue(c1); 87 FREECHAR(name,c1); 88 } 89 90 PETSC_EXTERN void PETSC_STDCALL petscoptionshasname_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 91 PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 92 { 93 char *c1,*c2; 94 95 FIXCHAR(pre,len1,c1); 96 FIXCHAR(name,len2,c2); 97 *ierr = PetscOptionsHasName(c1,c2,flg); 98 FREECHAR(pre,c1); 99 FREECHAR(name,c2); 100 } 101 102 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetint_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 103 PetscInt *ivalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 104 { 105 char *c1,*c2; 106 PetscBool flag; 107 108 FIXCHAR(pre,len1,c1); 109 FIXCHAR(name,len2,c2); 110 *ierr = PetscOptionsGetInt(c1,c2,ivalue,&flag); 111 if (!FORTRANNULLBOOL(flg)) *flg = flag; 112 FREECHAR(pre,c1); 113 FREECHAR(name,c2); 114 } 115 116 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetenumprivate_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2),const char *const*list, 117 PetscEnum *ivalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 118 { 119 char *c1,*c2; 120 PetscBool flag; 121 122 FIXCHAR(pre,len1,c1); 123 FIXCHAR(name,len2,c2); 124 *ierr = PetscOptionsGetEnum(c1,c2,list,ivalue,&flag); 125 if (!FORTRANNULLBOOL(flg)) *flg = flag; 126 FREECHAR(pre,c1); 127 FREECHAR(name,c2); 128 } 129 130 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetbool_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 131 PetscBool *ivalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 132 { 133 char *c1,*c2; 134 PetscBool flag; 135 136 FIXCHAR(pre,len1,c1); 137 FIXCHAR(name,len2,c2); 138 *ierr = PetscOptionsGetBool(c1,c2,ivalue,&flag); 139 if (!FORTRANNULLBOOL(flg)) *flg = flag; 140 FREECHAR(pre,c1); 141 FREECHAR(name,c2); 142 } 143 144 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetreal_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 145 PetscReal *dvalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 146 { 147 char *c1,*c2; 148 PetscBool flag; 149 150 FIXCHAR(pre,len1,c1); 151 FIXCHAR(name,len2,c2); 152 *ierr = PetscOptionsGetReal(c1,c2,dvalue,&flag); 153 if (!FORTRANNULLBOOL(flg)) *flg = flag; 154 FREECHAR(pre,c1); 155 FREECHAR(name,c2); 156 } 157 158 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetrealarray_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 159 PetscReal *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 160 { 161 char *c1,*c2; 162 PetscBool flag; 163 164 FIXCHAR(pre,len1,c1); 165 FIXCHAR(name,len2,c2); 166 *ierr = PetscOptionsGetRealArray(c1,c2,dvalue,nmax,&flag); 167 if (!FORTRANNULLBOOL(flg)) *flg = flag; 168 FREECHAR(pre,c1); 169 FREECHAR(name,c2); 170 } 171 172 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetintarray_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 173 PetscInt *dvalue,PetscInt *nmax,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 *ierr = PetscOptionsGetIntArray(c1,c2,dvalue,nmax,&flag); 181 if (!FORTRANNULLBOOL(flg)) *flg = flag; 182 FREECHAR(pre,c1); 183 FREECHAR(name,c2); 184 } 185 186 PETSC_EXTERN void PETSC_STDCALL petscoptionsgetstring_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 187 CHAR string PETSC_MIXED_LEN(len),PetscBool *flg, 188 PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len)) 189 { 190 char *c1,*c2,*c3; 191 size_t len3; 192 PetscBool flag; 193 194 FIXCHAR(pre,len1,c1); 195 FIXCHAR(name,len2,c2); 196 c3 = string; 197 len3 = len - 1; 198 199 *ierr = PetscOptionsGetString(c1,c2,c3,len3,&flag); 200 if (!FORTRANNULLBOOL(flg)) *flg = flag; 201 FREECHAR(pre,c1); 202 FREECHAR(name,c2); 203 FIXRETURNCHAR(flag,string,len); 204 } 205 206 PETSC_EXTERN void PETSC_STDCALL petscgetprogramname_(CHAR name PETSC_MIXED_LEN(len_in),PetscErrorCode *ierr PETSC_END_LEN(len_in)) 207 { 208 char *tmp; 209 size_t len; 210 tmp = name; 211 len = len_in - 1; 212 *ierr = PetscGetProgramName(tmp,len); 213 FIXRETURNCHAR(PETSC_TRUE,name,len_in); 214 } 215 216 PETSC_EXTERN void PETSC_STDCALL petscoptionsview_(PetscViewer *vin,PetscErrorCode *ierr) 217 { 218 PetscViewer v; 219 220 PetscPatchDefaultViewers_Fortran(vin,v); 221 *ierr = PetscOptionsView(v); 222 } 223 224