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