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