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