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