1 #include <petsc/private/fortranimpl.h> 2 #include <petsc/private/f90impl.h> 3 #include <petscmat.h> 4 #include <petscviewer.h> 5 6 #if defined(PETSC_HAVE_FORTRAN_CAPS) 7 #define matsetvalues_ MATSETVALUES 8 #define matsetvaluesnnnn_ MATSETVALUESNNNN 9 #define matsetvalues0_ MATSETVALUES0 10 #define matsetvaluesnn1_ MATSETVALUESNN1 11 #define matsetvalues11_ MATSETVALUES11 12 #define matsetvalues1n_ MATSETVALUES1N 13 #define matsetvaluesn1_ MATSETVALUESN1 14 #define matsetvaluesblocked0_ MATSETVALUESBLOCKED0 15 #define matsetvaluesblocked11_ MATSETVALUESBLOCKED11 16 #define matsetvaluesblocked111_ MATSETVALUESBLOCKED111 17 #define matsetvaluesblocked1n_ MATSETVALUESBLOCKED1N 18 #define matsetvaluesblockedn1_ MATSETVALUESBLOCKEDN1 19 #define matsetvaluesblockedlocal_ MATSETVALUESBLOCKEDLOCAL 20 #define matsetvaluesblockedlocal0_ MATSETVALUESBLOCKEDLOCAL0 21 #define matsetvaluesblockedlocal11_ MATSETVALUESBLOCKEDLOCAL11 22 #define matsetvaluesblockedlocal111_ MATSETVALUESBLOCKEDLOCAL111 23 #define matsetvaluesblockedlocal1n_ MATSETVALUESBLOCKEDLOCAL1N 24 #define matsetvaluesblockedlocaln1_ MATSETVALUESBLOCKEDLOCALN1 25 #define matsetvalueslocal_ MATSETVALUESLOCAL 26 #define matsetvalueslocal0_ MATSETVALUESLOCAL0 27 #define matsetvalueslocal11_ MATSETVALUESLOCAL11 28 #define matsetvalueslocal11nn_ MATSETVALUESLOCAL11NN 29 #define matsetvalueslocal111_ MATSETVALUESLOCAL111 30 #define matsetvalueslocal1n_ MATSETVALUESLOCAL1N 31 #define matsetvalueslocaln1_ MATSETVALUESLOCALN1 32 #define matgetrowmin_ MATGETROWMIN 33 #define matgetrowminabs_ MATGETROWMINABS 34 #define matgetrowmax_ MATGETROWMAX 35 #define matgetrowmaxabs_ MATGETROWMAXABS 36 #define matdestroymatrices_ MATDESTROYMATRICES 37 #define matdestroysubmatrices_ MATDESTROYSUBMATRICES 38 #define matgetfactor_ MATGETFACTOR 39 #define matfactorgetsolverpackage_ MATFACTORGETSOLVERPACKAGE 40 #define matgetrowij_ MATGETROWIJ 41 #define matrestorerowij_ MATRESTOREROWIJ 42 #define matgetrow_ MATGETROW 43 #define matrestorerow_ MATRESTOREROW 44 #define matload_ MATLOAD 45 #define matview_ MATVIEW 46 #define matseqaijgetarray_ MATSEQAIJGETARRAY 47 #define matseqaijrestorearray_ MATSEQAIJRESTOREARRAY 48 #define matdensegetarray_ MATDENSEGETARRAY 49 #define matdenserestorearray_ MATDENSERESTOREARRAY 50 #define matconvert_ MATCONVERT 51 #define matcreatesubmatrices_ MATCREATESUBMATRICES 52 #define matzerorowscolumns_ MATZEROROWSCOLUMNS 53 #define matzerorowscolumnsis_ MATZEROROWSCOLUMNSIS 54 #define matzerorowsstencil_ MATZEROROWSSTENCIL 55 #define matzerorowscolumnsstencil_ MATZEROROWSCOLUMNSSTENCIL 56 #define matzerorows_ MATZEROROWS 57 #define matzerorowsis_ MATZEROROWSIS 58 #define matzerorowslocal_ MATZEROROWSLOCAL 59 #define matzerorowslocalis_ MATZEROROWSLOCALIS 60 #define matzerorowscolumnslocal_ MATZEROROWSCOLUMNSLOCAL 61 #define matzerorowscolumnslocalis_ MATZEROROWSCOLUMNSLOCALIS 62 #define matsetoptionsprefix_ MATSETOPTIONSPREFIX 63 #define matcreatevecs_ MATCREATEVECS 64 #define matnullspaceremove_ MATNULLSPACEREMOVE 65 #define matgetinfo_ MATGETINFO 66 #define matlufactor_ MATLUFACTOR 67 #define matilufactor_ MATILUFACTOR 68 #define matlufactorsymbolic_ MATLUFACTORSYMBOLIC 69 #define matlufactornumeric_ MATLUFACTORNUMERIC 70 #define matcholeskyfactor_ MATCHOLESKYFACTOR 71 #define matcholeskyfactorsymbolic_ MATCHOLESKYFACTORSYMBOLIC 72 #define matcholeskyfactornumeric_ MATCHOLESKYFACTORNUMERIC 73 #define matilufactorsymbolic_ MATILUFACTORSYMBOLIC 74 #define maticcfactorsymbolic_ MATICCFACTORSYMBOLIC 75 #define maticcfactor_ MATICCFACTOR 76 #define matfactorinfoinitialize_ MATFACTORINFOINITIALIZE 77 #define matnullspacesetfunction_ MATNULLSPACESETFUNCTION 78 #define matfindnonzerorows_ MATFINDNONZEROROWS 79 #define matgetsize00_ MATGETSIZE00 80 #define matgetsize10_ MATGETSIZE10 81 #define matgetsize01_ MATGETSIZE01 82 #define matgetlocalsize00_ MATGETLOCALSIZE00 83 #define matgetlocalsize10_ MATGETLOCALSIZE10 84 #define matgetlocalsize01_ MATGETLOCALSIZE01 85 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 86 #define matsetvalues_ matsetvalues 87 #define matsetvaluesnnnn_ matsetvaluesnnnn 88 #define matsetvalues0_ matsetvalues0 89 #define matsetvaluesnn1_ matsetvaluesnn1 90 #define matsetvalues11_ matsetvalues11 91 #define matsetvaluesn1_ matsetvaluesn1 92 #define matsetvalues1n_ matsetvalues1n 93 #define matsetvalueslocal_ matsetvalueslocal 94 #define matsetvalueslocal0_ matsetvalueslocal0 95 #define matsetvalueslocal11_ matsetvalueslocal11 96 #define matsetvalueslocal11nn_ matsetvalueslocal11nn 97 #define matsetvalueslocal111_ matsetvalueslocal111 98 #define matsetvalueslocal1n_ matsetvalueslocal1n 99 #define matsetvalueslocaln1_ matsetvalueslocaln1 100 #define matsetvaluesblocked_ matsetvaluesblocked 101 #define matsetvaluesblocked0_ matsetvaluesblocked0 102 #define matsetvaluesblocked11_ matsetvaluesblocked11 103 #define matsetvaluesblocked111_ matsetvaluesblocked111 104 #define matsetvaluesblocked1n_ matsetvaluesblocked1n 105 #define matsetvaluesblockedn1_ matsetvaluesblockedn1 106 #define matsetvaluesblockedlocal_ matsetvaluesblockedlocal 107 #define matsetvaluesblockedlocal0_ matsetvaluesblockedlocal0 108 #define matsetvaluesblockedlocal11_ matsetvaluesblockedlocal11 109 #define matsetvaluesblockedlocal111_ matsetvaluesblockedlocal111 110 #define matsetvaluesblockedlocal1n_ matsetvaluesblockedlocal1n 111 #define matsetvaluesblockedlocaln1_ matsetvaluesblockedlocaln1 112 #define matgetrowmin_ matgetrowmin 113 #define matgetrowminabs_ matgetrowminabs 114 #define matgetrowmax_ matgetrowmax 115 #define matgetrowmaxabs_ matgetrowmaxabs 116 #define matdestroymatrices_ matdestroymatrices 117 #define matdestroysubmatrices_ matdestroysubmatrices 118 #define matgetfactor_ matgetfactor 119 #define matfactorgetsolverpackage_ matfactorgetsolverpackage 120 #define matcreatevecs_ matcreatevecs 121 #define matgetrowij_ matgetrowij 122 #define matrestorerowij_ matrestorerowij 123 #define matgetrow_ matgetrow 124 #define matrestorerow_ matrestorerow 125 #define matview_ matview 126 #define matload_ matload 127 #define matseqaijgetarray_ matseqaijgetarray 128 #define matseqaijrestorearray_ matseqaijrestorearray 129 #define matdensegetarray_ matdensegetarray 130 #define matdenserestorearray_ matdenserestorearray 131 #define matconvert_ matconvert 132 #define matcreatesubmatrices_ matcreatesubmatrices 133 #define matzerorowscolumns_ matzerorowscolumns 134 #define matzerorowscolumnsis_ matzerorowscolumnsis 135 #define matzerorowsstencil_ matzerorowsstencil 136 #define matzerorowscolumnsstencil_ matzerorowscolumnsstencil 137 #define matzerorows_ matzerorows 138 #define matzerorowsis_ matzerorowsis 139 #define matzerorowslocal_ matzerorowslocal 140 #define matzerorowslocalis_ matzerorowslocalis 141 #define matzerorowscolumnslocal_ matzerorowscolumnslocal 142 #define matzerorowscolumnslocalis_ matzerorowscolumnslocalis 143 #define matsetoptionsprefix_ matsetoptionsprefix 144 #define matnullspaceremove_ matnullspaceremove 145 #define matgetinfo_ matgetinfo 146 #define matlufactor_ matlufactor 147 #define matilufactor_ matilufactor 148 #define matlufactorsymbolic_ matlufactorsymbolic 149 #define matlufactornumeric_ matlufactornumeric 150 #define matcholeskyfactor_ matcholeskyfactor 151 #define matcholeskyfactorsymbolic_ matcholeskyfactorsymbolic 152 #define matcholeskyfactornumeric_ matcholeskyfactornumeric 153 #define matilufactorsymbolic_ matilufactorsymbolic 154 #define maticcfactorsymbolic_ maticcfactorsymbolic 155 #define maticcfactor_ maticcfactor 156 #define matfactorinfoinitialize_ matfactorinfoinitialize 157 #define matnullspacesetfunction_ matnullspacesetfunction 158 #define matfindnonzerorows_ matfindnonzerorows 159 #define matgetsize00_ matgetsize00 160 #define matgetsize10_ matgetsize10 161 #define matgetsize01_ matgetsize01 162 #define matgetlocalsize00_ matgetlocalsize00 163 #define matgetlocalsize10_ matgetlocalsize10 164 #define matgetlocalsize01_ matgetlocalsize01 165 #endif 166 167 PETSC_EXTERN void PETSC_STDCALL matgetsize_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 168 { 169 CHKFORTRANNULLINTEGER(m); 170 CHKFORTRANNULLINTEGER(n); 171 *ierr = MatGetSize(*mat,m,n); 172 } 173 174 PETSC_EXTERN void PETSC_STDCALL matgetsize00_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 175 { 176 matgetsize_(mat,m,n,ierr); 177 } 178 179 PETSC_EXTERN void PETSC_STDCALL matgetsize10_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 180 { 181 matgetsize_(mat,m,n,ierr); 182 } 183 184 PETSC_EXTERN void PETSC_STDCALL matgetsize01_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 185 { 186 matgetsize_(mat,m,n,ierr); 187 } 188 189 PETSC_EXTERN void PETSC_STDCALL matgetlocalsize_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 190 { 191 CHKFORTRANNULLINTEGER(m); 192 CHKFORTRANNULLINTEGER(n); 193 *ierr = MatGetLocalSize(*mat,m,n); 194 } 195 196 PETSC_EXTERN void PETSC_STDCALL matgetlocalsize00_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 197 { 198 matgetlocalsize_(mat,m,n,ierr); 199 } 200 201 PETSC_EXTERN void PETSC_STDCALL matgetlocalsize10_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 202 { 203 matgetlocalsize_(mat,m,n,ierr); 204 } 205 206 PETSC_EXTERN void PETSC_STDCALL matgetlocalsize01_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 207 { 208 matgetlocalsize_(mat,m,n,ierr); 209 } 210 211 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblocked_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 212 *ierr = MatSetValuesBlocked(*mat,*m,idxm,*n,idxn,v,*addv); 213 } 214 215 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblocked2_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], F90Array2d *y,InsertMode *addv, int *ierr PETSC_F90_2PTR_PROTO(ptrd)){ 216 PetscScalar *fa; 217 *ierr = F90Array2dAccess(y,PETSC_SCALAR,(void**)&fa PETSC_F90_2PTR_PARAM(ptrd));if (*ierr) return; 218 matsetvaluesblocked_(mat,m,idxm,n,idxn,fa,addv,ierr); 219 } 220 221 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblocked0_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 222 matsetvaluesblocked_(mat,m,idxm,n,idxn,v,addv,ierr); 223 } 224 225 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblocked11_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 226 matsetvaluesblocked_(mat,m,idxm,n,idxn,v,addv,ierr); 227 } 228 229 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblocked111_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 230 matsetvaluesblocked_(mat,m,idxm,n,idxn,v,addv,ierr); 231 } 232 233 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblocked1n_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 234 matsetvaluesblocked_(mat,m,idxm,n,idxn,v,addv,ierr); 235 } 236 237 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblockedn1_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 238 matsetvaluesblocked_(mat,m,idxm,n,idxn,v,addv,ierr); 239 } 240 241 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblockedlocal_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 242 { 243 *ierr = MatSetValuesBlockedLocal(*mat,*nrow,irow,*ncol,icol,y,*addv); 244 } 245 246 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblockedlocal0_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 247 matsetvaluesblockedlocal_(mat,m,idxm,n,idxn,v,addv,ierr); 248 } 249 250 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblockedlocal11_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 251 matsetvaluesblockedlocal_(mat,m,idxm,n,idxn,v,addv,ierr); 252 } 253 254 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblockedlocal111_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 255 matsetvaluesblockedlocal_(mat,m,idxm,n,idxn,v,addv,ierr); 256 } 257 258 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblockedlocal1n_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 259 matsetvaluesblockedlocal_(mat,m,idxm,n,idxn,v,addv,ierr); 260 } 261 262 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblockedlocaln1_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 263 matsetvaluesblockedlocal_(mat,m,idxm,n,idxn,v,addv,ierr); 264 } 265 266 PETSC_EXTERN void PETSC_STDCALL matsetvalues_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ) 267 { 268 *ierr = MatSetValues(*mat,*m,idxm,*n,idxn,v,*addv); 269 } 270 271 PETSC_EXTERN void PETSC_STDCALL matsetvaluesnnnn_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ) 272 { 273 matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr); 274 } 275 276 PETSC_EXTERN void PETSC_STDCALL matsetvalues0_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ) 277 { 278 matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr); 279 } 280 281 PETSC_EXTERN void PETSC_STDCALL matsetvaluesnn1_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ) 282 { 283 matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr); 284 } 285 286 PETSC_EXTERN void PETSC_STDCALL matsetvalues11_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ) 287 { 288 matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr); 289 } 290 291 PETSC_EXTERN void PETSC_STDCALL matsetvaluesn1_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ) 292 { 293 matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr); 294 } 295 296 PETSC_EXTERN void PETSC_STDCALL matsetvalues1n_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ) 297 { 298 matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr); 299 } 300 301 PETSC_EXTERN void PETSC_STDCALL matsetvalueslocal_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 302 { 303 *ierr = MatSetValuesLocal(*mat,*nrow,irow,*ncol,icol,y,*addv); 304 } 305 306 PETSC_EXTERN void PETSC_STDCALL matsetvalueslocal0_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 307 { 308 matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr); 309 } 310 311 PETSC_EXTERN void PETSC_STDCALL matsetvalueslocal11_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 312 { 313 matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr); 314 } 315 316 PETSC_EXTERN void PETSC_STDCALL matsetvalueslocal11nn_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 317 { 318 matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr); 319 } 320 321 PETSC_EXTERN void PETSC_STDCALL matsetvalueslocal111_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 322 { 323 matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr); 324 } 325 326 PETSC_EXTERN void PETSC_STDCALL matsetvalueslocal1n_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 327 { 328 matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr); 329 } 330 331 PETSC_EXTERN void PETSC_STDCALL matsetvalueslocaln1_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 332 { 333 matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr); 334 } 335 336 PETSC_EXTERN void PETSC_STDCALL matgetrowmin_(Mat *mat,Vec *v,PetscInt idx[], int *ierr ) 337 { 338 CHKFORTRANNULLINTEGER(idx); 339 *ierr = MatGetRowMin(*mat,*v,idx); 340 } 341 342 PETSC_EXTERN void PETSC_STDCALL matgetrowminabs_(Mat *mat,Vec *v,PetscInt idx[], int *ierr ) 343 { 344 CHKFORTRANNULLINTEGER(idx); 345 *ierr = MatGetRowMinAbs(*mat,*v,idx); 346 } 347 348 PETSC_EXTERN void PETSC_STDCALL matgetrowmax_(Mat *mat,Vec *v,PetscInt idx[], int *ierr ) 349 { 350 CHKFORTRANNULLINTEGER(idx); 351 *ierr = MatGetRowMax(*mat,*v,idx); 352 } 353 354 PETSC_EXTERN void PETSC_STDCALL matgetrowmaxabs_(Mat *mat,Vec *v,PetscInt idx[], int *ierr ) 355 { 356 CHKFORTRANNULLINTEGER(idx); 357 *ierr = MatGetRowMaxAbs(*mat,*v,idx); 358 } 359 360 static PetscErrorCode ournullfunction(MatNullSpace sp,Vec x,void *ctx) 361 { 362 PetscErrorCode ierr = 0; 363 (*(void (PETSC_STDCALL *)(MatNullSpace*,Vec*,void*,PetscErrorCode*))(((PetscObject)sp)->fortran_func_pointers[0]))(&sp,&x,ctx,&ierr);CHKERRQ(ierr); 364 return 0; 365 } 366 367 PETSC_EXTERN void PETSC_STDCALL matnullspacesetfunction_(MatNullSpace *sp, PetscErrorCode (*rem)(MatNullSpace,Vec,void*),void *ctx,PetscErrorCode *ierr) 368 { 369 PetscObjectAllocateFortranPointers(*sp,1); 370 ((PetscObject)*sp)->fortran_func_pointers[0] = (PetscVoidFunction)rem; 371 372 *ierr = MatNullSpaceSetFunction(*sp,ournullfunction,ctx); 373 } 374 375 PETSC_EXTERN void PETSC_STDCALL matcreatevecs_(Mat *mat,Vec *right,Vec *left, int *ierr) 376 { 377 CHKFORTRANNULLOBJECT(right); 378 CHKFORTRANNULLOBJECT(left); 379 *ierr = MatCreateVecs(*mat,right,left); 380 } 381 382 PETSC_EXTERN void PETSC_STDCALL matgetrowij_(Mat *B,PetscInt *shift,PetscBool *sym,PetscBool *blockcompressed,PetscInt *n,PetscInt *ia,size_t *iia, 383 PetscInt *ja,size_t *jja,PetscBool *done,PetscErrorCode *ierr) 384 { 385 const PetscInt *IA,*JA; 386 *ierr = MatGetRowIJ(*B,*shift,*sym,*blockcompressed,n,&IA,&JA,done);if (*ierr) return; 387 *iia = PetscIntAddressToFortran(ia,(PetscInt*)IA); 388 *jja = PetscIntAddressToFortran(ja,(PetscInt*)JA); 389 } 390 391 PETSC_EXTERN void PETSC_STDCALL matrestorerowij_(Mat *B,PetscInt *shift,PetscBool *sym,PetscBool *blockcompressed, PetscInt *n,PetscInt *ia,size_t *iia, 392 PetscInt *ja,size_t *jja,PetscBool *done,PetscErrorCode *ierr) 393 { 394 const PetscInt *IA = PetscIntAddressFromFortran(ia,*iia),*JA = PetscIntAddressFromFortran(ja,*jja); 395 *ierr = MatRestoreRowIJ(*B,*shift,*sym,*blockcompressed,n,&IA,&JA,done); 396 } 397 398 /* 399 This is a poor way of storing the column and value pointers 400 generated by MatGetRow() to be returned with MatRestoreRow() 401 but there is not natural,good place else to store them. Hence 402 Fortran programmers can only have one outstanding MatGetRows() 403 at a time. 404 */ 405 static PetscErrorCode matgetrowactive = 0; 406 static const PetscInt *my_ocols = 0; 407 static const PetscScalar *my_ovals = 0; 408 409 PETSC_EXTERN void PETSC_STDCALL matgetrow_(Mat *mat,PetscInt *row,PetscInt *ncols,PetscInt *cols,PetscScalar *vals,PetscErrorCode *ierr) 410 { 411 const PetscInt **oocols = &my_ocols; 412 const PetscScalar **oovals = &my_ovals; 413 414 if (matgetrowactive) { 415 PetscError(PETSC_COMM_SELF,__LINE__,"MatGetRow_Fortran",__FILE__,PETSC_ERR_ARG_WRONGSTATE,PETSC_ERROR_INITIAL, 416 "Cannot have two MatGetRow() active simultaneously\n\ 417 call MatRestoreRow() before calling MatGetRow() a second time"); 418 *ierr = 1; 419 return; 420 } 421 422 CHKFORTRANNULLINTEGER(cols); if (!cols) oocols = NULL; 423 CHKFORTRANNULLSCALAR(vals); if (!vals) oovals = NULL; 424 425 *ierr = MatGetRow(*mat,*row,ncols,oocols,oovals); 426 if (*ierr) return; 427 428 if (oocols) { *ierr = PetscMemcpy(cols,my_ocols,(*ncols)*sizeof(PetscInt)); if (*ierr) return;} 429 if (oovals) { *ierr = PetscMemcpy(vals,my_ovals,(*ncols)*sizeof(PetscScalar)); if (*ierr) return;} 430 matgetrowactive = 1; 431 } 432 433 PETSC_EXTERN void PETSC_STDCALL matrestorerow_(Mat *mat,PetscInt *row,PetscInt *ncols,PetscInt *cols,PetscScalar *vals,PetscErrorCode *ierr) 434 { 435 const PetscInt **oocols = &my_ocols; 436 const PetscScalar **oovals = &my_ovals; 437 if (!matgetrowactive) { 438 PetscError(PETSC_COMM_SELF,__LINE__,"MatRestoreRow_Fortran",__FILE__,PETSC_ERR_ARG_WRONGSTATE,PETSC_ERROR_INITIAL, 439 "Must call MatGetRow() first"); 440 *ierr = 1; 441 return; 442 } 443 CHKFORTRANNULLINTEGER(cols); if (!cols) oocols = NULL; 444 CHKFORTRANNULLSCALAR(vals); if (!vals) oovals = NULL; 445 446 *ierr = MatRestoreRow(*mat,*row,ncols,oocols,oovals); 447 matgetrowactive = 0; 448 } 449 450 PETSC_EXTERN void PETSC_STDCALL matview_(Mat *mat,PetscViewer *vin,PetscErrorCode *ierr) 451 { 452 PetscViewer v; 453 PetscPatchDefaultViewers_Fortran(vin,v); 454 *ierr = MatView(*mat,v); 455 } 456 457 PETSC_EXTERN void PETSC_STDCALL matload_(Mat *mat,PetscViewer *vin,PetscErrorCode *ierr) 458 { 459 PetscViewer v; 460 PetscPatchDefaultViewers_Fortran(vin,v); 461 *ierr = MatLoad(*mat,v); 462 } 463 464 PETSC_EXTERN void PETSC_STDCALL matseqaijgetarray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr) 465 { 466 PetscScalar *mm; 467 PetscInt m,n; 468 469 *ierr = MatSeqAIJGetArray(*mat,&mm); if (*ierr) return; 470 *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return; 471 *ierr = PetscScalarAddressToFortran((PetscObject)*mat,1,fa,mm,m*n,ia); if (*ierr) return; 472 } 473 474 PETSC_EXTERN void PETSC_STDCALL matseqaijrestorearray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr) 475 { 476 PetscScalar *lx; 477 PetscInt m,n; 478 479 *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return; 480 *ierr = PetscScalarAddressFromFortran((PetscObject)*mat,fa,*ia,m*n,&lx);if (*ierr) return; 481 *ierr = MatSeqAIJRestoreArray(*mat,&lx);if (*ierr) return; 482 } 483 484 PETSC_EXTERN void PETSC_STDCALL matdensegetarray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr) 485 { 486 PetscScalar *mm; 487 PetscInt m,n; 488 489 *ierr = MatDenseGetArray(*mat,&mm); if (*ierr) return; 490 *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return; 491 *ierr = PetscScalarAddressToFortran((PetscObject)*mat,1,fa,mm,m*n,ia); if (*ierr) return; 492 } 493 494 PETSC_EXTERN void PETSC_STDCALL matdenserestorearray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr) 495 { 496 PetscScalar *lx; 497 PetscInt m,n; 498 499 *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return; 500 *ierr = PetscScalarAddressFromFortran((PetscObject)*mat,fa,*ia,m*n,&lx);if (*ierr) return; 501 *ierr = MatDenseRestoreArray(*mat,&lx);if (*ierr) return; 502 } 503 504 PETSC_EXTERN void PETSC_STDCALL matfactorgetsolverpackage_(Mat *mat,char* name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 505 { 506 const char *tname; 507 508 *ierr = MatFactorGetSolverPackage(*mat,&tname);if (*ierr) return; 509 if (name != PETSC_NULL_CHARACTER_Fortran) { 510 *ierr = PetscStrncpy(name,tname,len);if (*ierr) return; 511 } 512 FIXRETURNCHAR(PETSC_TRUE,name,len); 513 } 514 515 PETSC_EXTERN void PETSC_STDCALL matgetfactor_(Mat *mat,char* outtype PETSC_MIXED_LEN(len),MatFactorType *ftype,Mat *M,PetscErrorCode *ierr PETSC_END_LEN(len)) 516 { 517 char *t; 518 FIXCHAR(outtype,len,t); 519 *ierr = MatGetFactor(*mat,t,*ftype,M); 520 FREECHAR(outtype,t); 521 } 522 523 PETSC_EXTERN void PETSC_STDCALL matconvert_(Mat *mat,char* outtype PETSC_MIXED_LEN(len),MatReuse *reuse,Mat *M,PetscErrorCode *ierr PETSC_END_LEN(len)) 524 { 525 char *t; 526 FIXCHAR(outtype,len,t); 527 *ierr = MatConvert(*mat,t,*reuse,M); 528 FREECHAR(outtype,t); 529 } 530 531 /* 532 MatCreateSubmatrices() is slightly different from C since the 533 Fortran provides the array to hold the submatrix objects,while in C that 534 array is allocated by the MatCreateSubmatrices() 535 */ 536 PETSC_EXTERN void PETSC_STDCALL matcreatesubmatrices_(Mat *mat,PetscInt *n,IS *isrow,IS *iscol,MatReuse *scall,Mat *smat,PetscErrorCode *ierr) 537 { 538 Mat *lsmat; 539 PetscInt i; 540 541 if (*scall == MAT_INITIAL_MATRIX) { 542 *ierr = MatCreateSubMatrices(*mat,*n,isrow,iscol,*scall,&lsmat); 543 for (i=0; i<=*n; i++) { /* lsmat[*n] might be a dummy matrix for saving data struc */ 544 smat[i] = lsmat[i]; 545 } 546 *ierr = PetscFree(lsmat); 547 } else { 548 *ierr = MatCreateSubMatrices(*mat,*n,isrow,iscol,*scall,&smat); 549 } 550 } 551 552 /* 553 MatDestroyMatrices() is slightly different from C since the 554 Fortran does not free the array of matrix objects, while in C that 555 the array is freed 556 */ 557 PETSC_EXTERN void PETSC_STDCALL matdestroymatrices_(PetscInt *n,Mat *smat,PetscErrorCode *ierr) 558 { 559 PetscInt i; 560 561 for (i=0; i<*n; i++) { 562 *ierr = MatDestroy(&smat[i]);if (*ierr) return; 563 } 564 } 565 566 /* 567 MatDestroySubMatrices() is slightly different from C since the 568 Fortran provides the array to hold the submatrix objects, while in C that 569 array is allocated by the MatCreateSubmatrices() 570 */ 571 PETSC_EXTERN void PETSC_STDCALL matdestroysubmatrices_(PetscInt *n,Mat *smat,PetscErrorCode *ierr) 572 { 573 Mat *lsmat; 574 PetscInt i; 575 576 *ierr = PetscMalloc1(*n+1,&lsmat); 577 for (i=0; i<=*n; i++) { 578 lsmat[i] = smat[i]; 579 } 580 *ierr = MatDestroySubMatrices(*n,&lsmat); 581 } 582 583 PETSC_EXTERN void PETSC_STDCALL matzerorowscolumns_(Mat *mat,PetscInt *numRows,PetscInt *rows,PetscScalar *diag,Vec *x,Vec *b,PetscErrorCode *ierr) 584 { 585 CHKFORTRANNULLOBJECTDEREFERENCE(x); 586 CHKFORTRANNULLOBJECTDEREFERENCE(b); 587 *ierr = MatZeroRowsColumns(*mat,*numRows,rows,*diag,*x,*b); 588 } 589 590 PETSC_EXTERN void PETSC_STDCALL matzerorowscolumnsis_(Mat *mat,IS *is,PetscScalar *diag,Vec *x,Vec *b,PetscErrorCode *ierr) 591 { 592 CHKFORTRANNULLOBJECTDEREFERENCE(x); 593 CHKFORTRANNULLOBJECTDEREFERENCE(b); 594 *ierr = MatZeroRowsColumnsIS(*mat,*is,*diag,*x,*b); 595 } 596 597 PETSC_EXTERN void PETSC_STDCALL matzerorowsstencil_(Mat *mat,PetscInt *numRows,MatStencil *rows,PetscScalar *diag,Vec *x,Vec *b,PetscErrorCode *ierr) 598 { 599 CHKFORTRANNULLOBJECTDEREFERENCE(x); 600 CHKFORTRANNULLOBJECTDEREFERENCE(b); 601 *ierr = MatZeroRowsStencil(*mat,*numRows,rows,*diag,*x,*b); 602 } 603 604 PETSC_EXTERN void PETSC_STDCALL matzerorowscolumnsstencil_(Mat *mat,PetscInt *numRows,MatStencil *rows,PetscScalar *diag,Vec *x,Vec *b,PetscErrorCode *ierr) 605 { 606 CHKFORTRANNULLOBJECTDEREFERENCE(x); 607 CHKFORTRANNULLOBJECTDEREFERENCE(b); 608 *ierr = MatZeroRowsColumnsStencil(*mat,*numRows,rows,*diag,*x,*b); 609 } 610 611 PETSC_EXTERN void PETSC_STDCALL matzerorows_(Mat *mat,PetscInt *numRows,PetscInt *rows,PetscScalar *diag,Vec *x,Vec *b,PetscErrorCode *ierr) 612 { 613 CHKFORTRANNULLOBJECTDEREFERENCE(x); 614 CHKFORTRANNULLOBJECTDEREFERENCE(b); 615 *ierr = MatZeroRows(*mat,*numRows,rows,*diag,*x,*b); 616 } 617 618 PETSC_EXTERN void PETSC_STDCALL matzerorowsis_(Mat *mat,IS *is,PetscScalar *diag,Vec *x,Vec *b,PetscErrorCode *ierr) 619 { 620 CHKFORTRANNULLOBJECTDEREFERENCE(x); 621 CHKFORTRANNULLOBJECTDEREFERENCE(b); 622 *ierr = MatZeroRowsIS(*mat,*is,*diag,*x,*b); 623 } 624 625 PETSC_EXTERN void PETSC_STDCALL matzerorowslocal_(Mat *mat,PetscInt *numRows,PetscInt *rows,PetscScalar *diag,Vec *x,Vec *b,PetscErrorCode *ierr) 626 { 627 CHKFORTRANNULLOBJECTDEREFERENCE(x); 628 CHKFORTRANNULLOBJECTDEREFERENCE(b); 629 *ierr = MatZeroRowsLocal(*mat,*numRows,rows,*diag,*x,*b); 630 } 631 632 PETSC_EXTERN void PETSC_STDCALL matzerorowslocalis_(Mat *mat,IS *is,PetscScalar *diag,Vec *x,Vec *b,PetscErrorCode *ierr) 633 { 634 CHKFORTRANNULLOBJECTDEREFERENCE(x); 635 CHKFORTRANNULLOBJECTDEREFERENCE(b); 636 *ierr = MatZeroRowsLocalIS(*mat,*is,*diag,*x,*b); 637 } 638 639 PETSC_EXTERN void PETSC_STDCALL matzerorowscolumnslocal_(Mat *mat,PetscInt *numRows,PetscInt *rows,PetscScalar *diag,Vec *x,Vec *b,PetscErrorCode *ierr) 640 { 641 CHKFORTRANNULLOBJECTDEREFERENCE(x); 642 CHKFORTRANNULLOBJECTDEREFERENCE(b); 643 *ierr = MatZeroRowsColumnsLocal(*mat,*numRows,rows,*diag,*x,*b); 644 } 645 646 PETSC_EXTERN void PETSC_STDCALL matzerorowscolumnslocalis_(Mat *mat,IS *is,PetscScalar *diag,Vec *x,Vec *b,PetscErrorCode *ierr) 647 { 648 CHKFORTRANNULLOBJECTDEREFERENCE(x); 649 CHKFORTRANNULLOBJECTDEREFERENCE(b); 650 *ierr = MatZeroRowsColumnsLocalIS(*mat,*is,*diag,*x,*b); 651 } 652 653 PETSC_EXTERN void PETSC_STDCALL matsetoptionsprefix_(Mat *mat,char* prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 654 { 655 char *t; 656 657 FIXCHAR(prefix,len,t); 658 *ierr = MatSetOptionsPrefix(*mat,t); 659 FREECHAR(prefix,t); 660 } 661 662 PETSC_EXTERN void PETSC_STDCALL matnullspaceremove_(MatNullSpace *sp,Vec *vec,PetscErrorCode *ierr) 663 { 664 *ierr = MatNullSpaceRemove(*sp,*vec); 665 } 666 667 PETSC_EXTERN void PETSC_STDCALL matgetinfo_(Mat *mat,MatInfoType *flag,MatInfo *info, int *ierr) 668 { 669 *ierr = MatGetInfo(*mat,*flag,info); 670 } 671 672 PETSC_EXTERN void PETSC_STDCALL matlufactor_(Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr) 673 { 674 *ierr = MatLUFactor(*mat,*row,*col,info); 675 } 676 677 PETSC_EXTERN void PETSC_STDCALL matilufactor_(Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr) 678 { 679 *ierr = MatILUFactor(*mat,*row,*col,info); 680 } 681 682 PETSC_EXTERN void PETSC_STDCALL matlufactorsymbolic_(Mat *fact,Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr) 683 { 684 *ierr = MatLUFactorSymbolic(*fact,*mat,*row,*col,info); 685 } 686 687 PETSC_EXTERN void PETSC_STDCALL matlufactornumeric_(Mat *fact,Mat *mat,const MatFactorInfo *info, int *ierr) 688 { 689 *ierr = MatLUFactorNumeric(*fact,*mat,info); 690 } 691 692 PETSC_EXTERN void PETSC_STDCALL matcholeskyfactor_(Mat *mat,IS *perm,const MatFactorInfo *info, int *ierr) 693 { 694 *ierr = MatCholeskyFactor(*mat,*perm,info); 695 } 696 697 PETSC_EXTERN void PETSC_STDCALL matcholeskyfactorsymbolic_(Mat *fact,Mat *mat,IS *perm,const MatFactorInfo *info, int *ierr) 698 { 699 *ierr = MatCholeskyFactorSymbolic(*fact,*mat,*perm,info); 700 } 701 702 PETSC_EXTERN void PETSC_STDCALL matcholeskyfactornumeric_(Mat *fact,Mat *mat,const MatFactorInfo *info, int *ierr) 703 { 704 *ierr = MatCholeskyFactorNumeric(*fact,*mat,info); 705 } 706 707 PETSC_EXTERN void PETSC_STDCALL matilufactorsymbolic_(Mat *fact,Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr) 708 { 709 *ierr = MatILUFactorSymbolic(*fact,*mat,*row,*col,info); 710 } 711 712 PETSC_EXTERN void PETSC_STDCALL maticcfactorsymbolic_(Mat *fact,Mat *mat,IS *perm,const MatFactorInfo *info, int *ierr) 713 { 714 *ierr = MatICCFactorSymbolic(*fact,*mat,*perm,info); 715 } 716 717 PETSC_EXTERN void PETSC_STDCALL maticcfactor_(Mat *mat,IS *row,const MatFactorInfo *info, int *ierr) 718 { 719 *ierr = MatICCFactor(*mat,*row,info); 720 } 721 722 PETSC_EXTERN void PETSC_STDCALL matfactorinfoinitialize_(MatFactorInfo *info, int *ierr) 723 { 724 *ierr = MatFactorInfoInitialize(info); 725 } 726