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