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 "private/fortranimpl.h" 8 9 #ifdef PETSC_HAVE_FORTRAN_CAPS 10 #define petscoptionsgetbool_ PETSCOPTIONSGETBOOL 11 #define petscoptionsgetintarray_ PETSCOPTIONSGETINTARRAY 12 #define petscoptionssetvalue_ PETSCOPTIONSSETVALUE 13 #define petscoptionsclearvalue_ PETSCOPTIONSCLEARVALUE 14 #define petscoptionshasname_ PETSCOPTIONSHASNAME 15 #define petscoptionsgetint_ PETSCOPTIONSGETINT 16 #define petscoptionsgetreal_ PETSCOPTIONSGETREAL 17 #define petscoptionsgetrealarray_ PETSCOPTIONSGETREALARRAY 18 #define petscoptionsgetstring_ PETSCOPTIONSGETSTRING 19 #define petscgetprogramname PETSCGETPROGRAMNAME 20 #define petscoptionsinsertfile_ PETSCOPTIONSINSERTFILE 21 #define petscoptionsclear_ PETSCOPTIONSCLEAR 22 #define petscoptionsinsertstring_ PETSCOPTIONSINSERTSTRING 23 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 24 #define petscoptionsgetbool_ petscoptionsgetbool 25 #define petscoptionssetvalue_ petscoptionssetvalue 26 #define petscoptionsclearvalue_ petscoptionsclearvalue 27 #define petscoptionshasname_ petscoptionshasname 28 #define petscoptionsgetint_ petscoptionsgetint 29 #define petscoptionsgetreal_ petscoptionsgetreal 30 #define petscoptionsgetrealarray_ petscoptionsgetrealarray 31 #define petscoptionsgetstring_ petscoptionsgetstring 32 #define petscoptionsgetintarray_ petscoptionsgetintarray 33 #define petscgetprogramname_ petscgetprogramname 34 #define petscoptionsinsertfile_ petscoptionsinsertfile 35 #define petscoptionsclear_ petscoptionsclear 36 #define petscoptionsinsertstring_ petscoptionsinsertstring 37 #endif 38 39 EXTERN_C_BEGIN 40 41 /* ---------------------------------------------------------------------*/ 42 43 void PETSC_STDCALL petscoptionsinsertstring_(CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 44 { 45 char *c1; 46 47 FIXCHAR(file,len,c1); 48 *ierr = PetscOptionsInsertString(c1); 49 FREECHAR(file,c1); 50 } 51 52 void PETSC_STDCALL petscoptionsinsertfile_(MPI_Fint *comm,CHAR file PETSC_MIXED_LEN(len),PetscBool *require,PetscErrorCode *ierr PETSC_END_LEN(len)) 53 { 54 char *c1; 55 56 FIXCHAR(file,len,c1); 57 *ierr = PetscOptionsInsertFile(MPI_Comm_f2c(*comm),c1,*require); 58 FREECHAR(file,c1); 59 } 60 61 void PETSC_STDCALL petscoptionssetvalue_(CHAR name PETSC_MIXED_LEN(len1),CHAR value PETSC_MIXED_LEN(len2), 62 PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 63 { 64 char *c1,*c2; 65 66 FIXCHAR(name,len1,c1); 67 FIXCHAR(value,len2,c2); 68 *ierr = PetscOptionsSetValue(c1,c2); 69 FREECHAR(name,c1); 70 FREECHAR(value,c2); 71 } 72 73 void PETSC_STDCALL petscoptionsclear_(PetscErrorCode *ierr) 74 { 75 *ierr = PetscOptionsClear(); 76 } 77 78 void PETSC_STDCALL petscoptionsclearvalue_(CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 79 { 80 char *c1; 81 82 FIXCHAR(name,len,c1); 83 *ierr = PetscOptionsClearValue(c1); 84 FREECHAR(name,c1); 85 } 86 87 void PETSC_STDCALL petscoptionshasname_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 88 PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 89 { 90 char *c1,*c2; 91 92 FIXCHAR(pre,len1,c1); 93 FIXCHAR(name,len2,c2); 94 *ierr = PetscOptionsHasName(c1,c2,flg); 95 FREECHAR(pre,c1); 96 FREECHAR(name,c2); 97 } 98 99 void PETSC_STDCALL petscoptionsgetint_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 100 PetscInt *ivalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 101 { 102 char *c1,*c2; 103 PetscBool flag; 104 105 FIXCHAR(pre,len1,c1); 106 FIXCHAR(name,len2,c2); 107 *ierr = PetscOptionsGetInt(c1,c2,ivalue,&flag); 108 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 109 FREECHAR(pre,c1); 110 FREECHAR(name,c2); 111 } 112 113 void PETSC_STDCALL petscoptionsgetbool_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 114 PetscBool *ivalue,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 115 { 116 char *c1,*c2; 117 PetscBool flag; 118 119 FIXCHAR(pre,len1,c1); 120 FIXCHAR(name,len2,c2); 121 *ierr = PetscOptionsGetBool(c1,c2,ivalue,&flag); 122 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 123 FREECHAR(pre,c1); 124 FREECHAR(name,c2); 125 } 126 127 void PETSC_STDCALL petscoptionsgetreal_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 128 PetscReal *dvalue,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 *ierr = PetscOptionsGetReal(c1,c2,dvalue,&flag); 136 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 137 FREECHAR(pre,c1); 138 FREECHAR(name,c2); 139 } 140 141 void PETSC_STDCALL petscoptionsgetrealarray_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 142 PetscReal *dvalue,PetscInt *nmax,PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 143 { 144 char *c1,*c2; 145 PetscBool flag; 146 147 FIXCHAR(pre,len1,c1); 148 FIXCHAR(name,len2,c2); 149 *ierr = PetscOptionsGetRealArray(c1,c2,dvalue,nmax,&flag); 150 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 151 FREECHAR(pre,c1); 152 FREECHAR(name,c2); 153 } 154 155 void PETSC_STDCALL petscoptionsgetintarray_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 156 PetscInt *dvalue,PetscInt *nmax,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 *ierr = PetscOptionsGetIntArray(c1,c2,dvalue,nmax,&flag); 164 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 165 FREECHAR(pre,c1); 166 FREECHAR(name,c2); 167 } 168 169 void PETSC_STDCALL petscoptionsgetstring_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 170 CHAR string PETSC_MIXED_LEN(len),PetscBool *flg, 171 PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len)) 172 { 173 char *c1,*c2,*c3; 174 size_t len3; 175 PetscBool flag; 176 177 FIXCHAR(pre,len1,c1); 178 FIXCHAR(name,len2,c2); 179 c3 = string; 180 len3 = len - 1; 181 182 *ierr = PetscOptionsGetString(c1,c2,c3,len3,&flag); 183 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 184 FREECHAR(pre,c1); 185 FREECHAR(name,c2); 186 FIXRETURNCHAR(flag,string,len); 187 } 188 189 void PETSC_STDCALL petscgetprogramname_(CHAR name PETSC_MIXED_LEN(len_in),PetscErrorCode *ierr PETSC_END_LEN(len_in)) 190 { 191 char *tmp; 192 size_t len; 193 tmp = name; 194 len = len_in - 1; 195 *ierr = PetscGetProgramName(tmp,len); 196 FIXRETURNCHAR(PETSC_TRUE,name,len_in); 197 } 198 199 EXTERN_C_END 200 201