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 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 24 #define petscoptionsgettruth_ petscoptionsgettruth 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 #endif 37 38 EXTERN_C_BEGIN 39 40 /* ---------------------------------------------------------------------*/ 41 42 void PETSC_STDCALL petscoptionsinsertfile_(CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 43 { 44 char *c1; 45 46 FIXCHAR(file,len,c1); 47 *ierr = PetscOptionsInsertFile(c1); 48 FREECHAR(file,c1); 49 } 50 51 void PETSC_STDCALL petscoptionssetvalue_(CHAR name PETSC_MIXED_LEN(len1),CHAR value PETSC_MIXED_LEN(len2), 52 PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 53 { 54 char *c1,*c2; 55 56 FIXCHAR(name,len1,c1); 57 FIXCHAR(value,len2,c2); 58 *ierr = PetscOptionsSetValue(c1,c2); 59 FREECHAR(name,c1); 60 FREECHAR(value,c2); 61 } 62 63 void PETSC_STDCALL petscoptionsclear_(PetscErrorCode *ierr) 64 { 65 *ierr = PetscOptionsClear(); 66 } 67 68 void PETSC_STDCALL petscoptionsclearvalue_(CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 69 { 70 char *c1; 71 72 FIXCHAR(name,len,c1); 73 *ierr = PetscOptionsClearValue(c1); 74 FREECHAR(name,c1); 75 } 76 77 void PETSC_STDCALL petscoptionshasname_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 78 PetscTruth *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 79 { 80 char *c1,*c2; 81 82 FIXCHAR(pre,len1,c1); 83 FIXCHAR(name,len2,c2); 84 *ierr = PetscOptionsHasName(c1,c2,flg); 85 FREECHAR(pre,c1); 86 FREECHAR(name,c2); 87 } 88 89 void PETSC_STDCALL petscoptionsgetint_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 90 PetscInt *ivalue,PetscTruth *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 91 { 92 char *c1,*c2; 93 PetscTruth flag; 94 95 FIXCHAR(pre,len1,c1); 96 FIXCHAR(name,len2,c2); 97 *ierr = PetscOptionsGetInt(c1,c2,ivalue,&flag); 98 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 99 FREECHAR(pre,c1); 100 FREECHAR(name,c2); 101 } 102 103 void PETSC_STDCALL petscoptionsgettruth_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 104 PetscTruth *ivalue,PetscTruth *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 105 { 106 char *c1,*c2; 107 PetscTruth flag; 108 109 FIXCHAR(pre,len1,c1); 110 FIXCHAR(name,len2,c2); 111 *ierr = PetscOptionsGetTruth(c1,c2,ivalue,&flag); 112 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 113 FREECHAR(pre,c1); 114 FREECHAR(name,c2); 115 } 116 117 void PETSC_STDCALL petscoptionsgetreal_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 118 PetscReal *dvalue,PetscTruth *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 119 { 120 char *c1,*c2; 121 PetscTruth flag; 122 123 FIXCHAR(pre,len1,c1); 124 FIXCHAR(name,len2,c2); 125 *ierr = PetscOptionsGetReal(c1,c2,dvalue,&flag); 126 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 127 FREECHAR(pre,c1); 128 FREECHAR(name,c2); 129 } 130 131 void PETSC_STDCALL petscoptionsgetrealarray_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 132 PetscReal *dvalue,PetscInt *nmax,PetscTruth *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 133 { 134 char *c1,*c2; 135 PetscTruth flag; 136 137 FIXCHAR(pre,len1,c1); 138 FIXCHAR(name,len2,c2); 139 *ierr = PetscOptionsGetRealArray(c1,c2,dvalue,nmax,&flag); 140 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 141 FREECHAR(pre,c1); 142 FREECHAR(name,c2); 143 } 144 145 void PETSC_STDCALL petscoptionsgetintarray_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 146 PetscInt *dvalue,PetscInt *nmax,PetscTruth *flg,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 147 { 148 char *c1,*c2; 149 PetscTruth flag; 150 151 FIXCHAR(pre,len1,c1); 152 FIXCHAR(name,len2,c2); 153 *ierr = PetscOptionsGetIntArray(c1,c2,dvalue,nmax,&flag); 154 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 155 FREECHAR(pre,c1); 156 FREECHAR(name,c2); 157 } 158 159 void PETSC_STDCALL petscoptionsgetstring_(CHAR pre PETSC_MIXED_LEN(len1),CHAR name PETSC_MIXED_LEN(len2), 160 CHAR string PETSC_MIXED_LEN(len),PetscTruth *flg, 161 PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len)) 162 { 163 char *c1,*c2,*c3; 164 size_t len3; 165 PetscTruth flag; 166 167 FIXCHAR(pre,len1,c1); 168 FIXCHAR(name,len2,c2); 169 c3 = string; 170 len3 = len - 1; 171 172 *ierr = PetscOptionsGetString(c1,c2,c3,len3,&flag); 173 if (!FORTRANNULLTRUTH(flg)) *flg = flag; 174 FREECHAR(pre,c1); 175 FREECHAR(name,c2); 176 FIXRETURNCHAR(flag,string,len); 177 } 178 179 void PETSC_STDCALL petscgetprogramname_(CHAR name PETSC_MIXED_LEN(len_in),PetscErrorCode *ierr PETSC_END_LEN(len_in)) 180 { 181 char *tmp; 182 size_t len; 183 tmp = name; 184 len = len_in - 1; 185 *ierr = PetscGetProgramName(tmp,len); 186 FIXRETURNCHAR(PETSC_TRUE,name,len_in); 187 } 188 189 EXTERN_C_END 190 191