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