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