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 matsetnullspace_ MATSETNULLSPACE 89 #define matgetownershiprange_ MATGETOWNERSHIPRANGE 90 #define matgetownershipis_ MATGETOWNERSHIPIS 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 matsetnullspace_ matsetnullspace 176 #define matgetownershiprange_ matgetownershiprange 177 #define matgetownershipis_ matgetownershipis 178 #define matgetownershiprangecolumn_ matgetownershiprangecolumn 179 #endif 180 181 PETSC_EXTERN void PETSC_STDCALL matgetownershiprange_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 182 { 183 CHKFORTRANNULLINTEGER(m); 184 CHKFORTRANNULLINTEGER(n); 185 *ierr = MatGetOwnershipRange(*mat,m,n); 186 } 187 188 PETSC_EXTERN void PETSC_STDCALL matgetownershipis_(Mat *mat,IS *m,IS *n, int *ierr ) 189 { 190 CHKFORTRANNULLOBJECT(m); 191 CHKFORTRANNULLOBJECT(n); 192 *ierr = MatGetOwnershipIS(*mat,m,n); 193 } 194 195 PETSC_EXTERN void PETSC_STDCALL matgetownershiprangecolumn_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 196 { 197 CHKFORTRANNULLINTEGER(m); 198 CHKFORTRANNULLINTEGER(n); 199 *ierr = MatGetOwnershipRangeColumn(*mat,m,n); 200 } 201 202 PETSC_EXTERN void PETSC_STDCALL matgetsize_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 203 { 204 CHKFORTRANNULLINTEGER(m); 205 CHKFORTRANNULLINTEGER(n); 206 *ierr = MatGetSize(*mat,m,n); 207 } 208 209 PETSC_EXTERN void PETSC_STDCALL matgetsize00_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 210 { 211 matgetsize_(mat,m,n,ierr); 212 } 213 214 PETSC_EXTERN void PETSC_STDCALL matgetsize10_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 215 { 216 matgetsize_(mat,m,n,ierr); 217 } 218 219 PETSC_EXTERN void PETSC_STDCALL matgetsize01_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 220 { 221 matgetsize_(mat,m,n,ierr); 222 } 223 224 PETSC_EXTERN void PETSC_STDCALL matgetlocalsize_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 225 { 226 CHKFORTRANNULLINTEGER(m); 227 CHKFORTRANNULLINTEGER(n); 228 *ierr = MatGetLocalSize(*mat,m,n); 229 } 230 231 PETSC_EXTERN void PETSC_STDCALL matgetlocalsize00_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 232 { 233 matgetlocalsize_(mat,m,n,ierr); 234 } 235 236 PETSC_EXTERN void PETSC_STDCALL matgetlocalsize10_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 237 { 238 matgetlocalsize_(mat,m,n,ierr); 239 } 240 241 PETSC_EXTERN void PETSC_STDCALL matgetlocalsize01_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr ) 242 { 243 matgetlocalsize_(mat,m,n,ierr); 244 } 245 246 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblocked_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 247 *ierr = MatSetValuesBlocked(*mat,*m,idxm,*n,idxn,v,*addv); 248 } 249 250 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)){ 251 PetscScalar *fa; 252 *ierr = F90Array2dAccess(y,MPIU_SCALAR,(void**)&fa PETSC_F90_2PTR_PARAM(ptrd));if (*ierr) return; 253 matsetvaluesblocked_(mat,m,idxm,n,idxn,fa,addv,ierr); 254 } 255 256 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblocked0_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 257 matsetvaluesblocked_(mat,m,idxm,n,idxn,v,addv,ierr); 258 } 259 260 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblocked11_(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 matsetvaluesblocked111_(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 matsetvaluesblocked1n_(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 matsetvaluesblockedn1_(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 matsetvaluesblockedlocal_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 277 { 278 *ierr = MatSetValuesBlockedLocal(*mat,*nrow,irow,*ncol,icol,y,*addv); 279 } 280 281 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblockedlocal0_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){ 282 matsetvaluesblockedlocal_(mat,m,idxm,n,idxn,v,addv,ierr); 283 } 284 285 PETSC_EXTERN void PETSC_STDCALL matsetvaluesblockedlocal11_(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 matsetvaluesblockedlocal111_(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 matsetvaluesblockedlocal1n_(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 matsetvaluesblockedlocaln1_(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 matsetvalues_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ) 302 { 303 *ierr = MatSetValues(*mat,*m,idxm,*n,idxn,v,*addv); 304 } 305 306 PETSC_EXTERN void PETSC_STDCALL matsetvaluesnnnn_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ) 307 { 308 matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr); 309 } 310 311 PETSC_EXTERN void PETSC_STDCALL matsetvalues0_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ) 312 { 313 matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr); 314 } 315 316 PETSC_EXTERN void PETSC_STDCALL matsetvaluesnn1_(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 matsetvalues11_(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 matsetvaluesn1_(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 matsetvalues1n_(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 matsetvalueslocal_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 337 { 338 *ierr = MatSetValuesLocal(*mat,*nrow,irow,*ncol,icol,y,*addv); 339 } 340 341 PETSC_EXTERN void PETSC_STDCALL matsetvalueslocal0_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 342 { 343 matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr); 344 } 345 346 PETSC_EXTERN void PETSC_STDCALL matsetvalueslocal11_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr ) 347 { 348 matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr); 349 } 350 351 PETSC_EXTERN void PETSC_STDCALL matsetvalueslocal11nn_(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 matsetvalueslocal111_(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 matsetvalueslocal1n_(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 matsetvalueslocaln1_(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 matgetrowmin_(Mat *mat,Vec *v,PetscInt idx[], int *ierr ) 372 { 373 CHKFORTRANNULLINTEGER(idx); 374 *ierr = MatGetRowMin(*mat,*v,idx); 375 } 376 377 PETSC_EXTERN void PETSC_STDCALL matgetrowminabs_(Mat *mat,Vec *v,PetscInt idx[], int *ierr ) 378 { 379 CHKFORTRANNULLINTEGER(idx); 380 *ierr = MatGetRowMinAbs(*mat,*v,idx); 381 } 382 383 PETSC_EXTERN void PETSC_STDCALL matgetrowmax_(Mat *mat,Vec *v,PetscInt idx[], int *ierr ) 384 { 385 CHKFORTRANNULLINTEGER(idx); 386 *ierr = MatGetRowMax(*mat,*v,idx); 387 } 388 389 PETSC_EXTERN void PETSC_STDCALL matgetrowmaxabs_(Mat *mat,Vec *v,PetscInt idx[], int *ierr ) 390 { 391 CHKFORTRANNULLINTEGER(idx); 392 *ierr = MatGetRowMaxAbs(*mat,*v,idx); 393 } 394 395 static PetscErrorCode ournullfunction(MatNullSpace sp,Vec x,void *ctx) 396 { 397 PetscErrorCode ierr = 0; 398 (*(void (PETSC_STDCALL *)(MatNullSpace*,Vec*,void*,PetscErrorCode*))(((PetscObject)sp)->fortran_func_pointers[0]))(&sp,&x,ctx,&ierr);CHKERRQ(ierr); 399 return 0; 400 } 401 402 PETSC_EXTERN void PETSC_STDCALL matnullspacesetfunction_(MatNullSpace *sp, PetscErrorCode (*rem)(MatNullSpace,Vec,void*),void *ctx,PetscErrorCode *ierr) 403 { 404 PetscObjectAllocateFortranPointers(*sp,1); 405 ((PetscObject)*sp)->fortran_func_pointers[0] = (PetscVoidFunction)rem; 406 407 *ierr = MatNullSpaceSetFunction(*sp,ournullfunction,ctx); 408 } 409 410 PETSC_EXTERN void PETSC_STDCALL matcreatevecs_(Mat *mat,Vec *right,Vec *left, int *ierr) 411 { 412 CHKFORTRANNULLOBJECT(right); 413 CHKFORTRANNULLOBJECT(left); 414 *ierr = MatCreateVecs(*mat,right,left); 415 } 416 417 PETSC_EXTERN void PETSC_STDCALL matgetrowij_(Mat *B,PetscInt *shift,PetscBool *sym,PetscBool *blockcompressed,PetscInt *n,PetscInt *ia,size_t *iia, 418 PetscInt *ja,size_t *jja,PetscBool *done,PetscErrorCode *ierr) 419 { 420 const PetscInt *IA,*JA; 421 *ierr = MatGetRowIJ(*B,*shift,*sym,*blockcompressed,n,&IA,&JA,done);if (*ierr) return; 422 *iia = PetscIntAddressToFortran(ia,(PetscInt*)IA); 423 *jja = PetscIntAddressToFortran(ja,(PetscInt*)JA); 424 } 425 426 PETSC_EXTERN void PETSC_STDCALL matrestorerowij_(Mat *B,PetscInt *shift,PetscBool *sym,PetscBool *blockcompressed, PetscInt *n,PetscInt *ia,size_t *iia, 427 PetscInt *ja,size_t *jja,PetscBool *done,PetscErrorCode *ierr) 428 { 429 const PetscInt *IA = PetscIntAddressFromFortran(ia,*iia),*JA = PetscIntAddressFromFortran(ja,*jja); 430 *ierr = MatRestoreRowIJ(*B,*shift,*sym,*blockcompressed,n,&IA,&JA,done); 431 } 432 433 /* 434 This is a poor way of storing the column and value pointers 435 generated by MatGetRow() to be returned with MatRestoreRow() 436 but there is not natural,good place else to store them. Hence 437 Fortran programmers can only have one outstanding MatGetRows() 438 at a time. 439 */ 440 static PetscErrorCode matgetrowactive = 0; 441 static const PetscInt *my_ocols = 0; 442 static const PetscScalar *my_ovals = 0; 443 444 PETSC_EXTERN void PETSC_STDCALL matgetrow_(Mat *mat,PetscInt *row,PetscInt *ncols,PetscInt *cols,PetscScalar *vals,PetscErrorCode *ierr) 445 { 446 const PetscInt **oocols = &my_ocols; 447 const PetscScalar **oovals = &my_ovals; 448 449 if (matgetrowactive) { 450 PetscError(PETSC_COMM_SELF,__LINE__,"MatGetRow_Fortran",__FILE__,PETSC_ERR_ARG_WRONGSTATE,PETSC_ERROR_INITIAL, 451 "Cannot have two MatGetRow() active simultaneously\n\ 452 call MatRestoreRow() before calling MatGetRow() a second time"); 453 *ierr = 1; 454 return; 455 } 456 457 CHKFORTRANNULLINTEGER(cols); if (!cols) oocols = NULL; 458 CHKFORTRANNULLSCALAR(vals); if (!vals) oovals = NULL; 459 460 *ierr = MatGetRow(*mat,*row,ncols,oocols,oovals); 461 if (*ierr) return; 462 463 if (oocols) { *ierr = PetscMemcpy(cols,my_ocols,(*ncols)*sizeof(PetscInt)); if (*ierr) return;} 464 if (oovals) { *ierr = PetscMemcpy(vals,my_ovals,(*ncols)*sizeof(PetscScalar)); if (*ierr) return;} 465 matgetrowactive = 1; 466 } 467 468 PETSC_EXTERN void PETSC_STDCALL matrestorerow_(Mat *mat,PetscInt *row,PetscInt *ncols,PetscInt *cols,PetscScalar *vals,PetscErrorCode *ierr) 469 { 470 const PetscInt **oocols = &my_ocols; 471 const PetscScalar **oovals = &my_ovals; 472 if (!matgetrowactive) { 473 PetscError(PETSC_COMM_SELF,__LINE__,"MatRestoreRow_Fortran",__FILE__,PETSC_ERR_ARG_WRONGSTATE,PETSC_ERROR_INITIAL, 474 "Must call MatGetRow() first"); 475 *ierr = 1; 476 return; 477 } 478 CHKFORTRANNULLINTEGER(cols); if (!cols) oocols = NULL; 479 CHKFORTRANNULLSCALAR(vals); if (!vals) oovals = NULL; 480 481 *ierr = MatRestoreRow(*mat,*row,ncols,oocols,oovals); 482 matgetrowactive = 0; 483 } 484 485 PETSC_EXTERN void PETSC_STDCALL matview_(Mat *mat,PetscViewer *vin,PetscErrorCode *ierr) 486 { 487 PetscViewer v; 488 PetscPatchDefaultViewers_Fortran(vin,v); 489 *ierr = MatView(*mat,v); 490 } 491 492 PETSC_EXTERN void PETSC_STDCALL matload_(Mat *mat,PetscViewer *vin,PetscErrorCode *ierr) 493 { 494 PetscViewer v; 495 PetscPatchDefaultViewers_Fortran(vin,v); 496 *ierr = MatLoad(*mat,v); 497 } 498 499 PETSC_EXTERN void PETSC_STDCALL matseqaijgetarray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr) 500 { 501 PetscScalar *mm; 502 PetscInt m,n; 503 504 *ierr = MatSeqAIJGetArray(*mat,&mm); if (*ierr) return; 505 *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return; 506 *ierr = PetscScalarAddressToFortran((PetscObject)*mat,1,fa,mm,m*n,ia); if (*ierr) return; 507 } 508 509 PETSC_EXTERN void PETSC_STDCALL matseqaijrestorearray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr) 510 { 511 PetscScalar *lx; 512 PetscInt m,n; 513 514 *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return; 515 *ierr = PetscScalarAddressFromFortran((PetscObject)*mat,fa,*ia,m*n,&lx);if (*ierr) return; 516 *ierr = MatSeqAIJRestoreArray(*mat,&lx);if (*ierr) return; 517 } 518 519 PETSC_EXTERN void PETSC_STDCALL matdensegetarray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr) 520 { 521 PetscScalar *mm; 522 PetscInt m,n; 523 524 *ierr = MatDenseGetArray(*mat,&mm); if (*ierr) return; 525 *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return; 526 *ierr = PetscScalarAddressToFortran((PetscObject)*mat,1,fa,mm,m*n,ia); if (*ierr) return; 527 } 528 529 PETSC_EXTERN void PETSC_STDCALL matdenserestorearray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr) 530 { 531 PetscScalar *lx; 532 PetscInt m,n; 533 534 *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return; 535 *ierr = PetscScalarAddressFromFortran((PetscObject)*mat,fa,*ia,m*n,&lx);if (*ierr) return; 536 *ierr = MatDenseRestoreArray(*mat,&lx);if (*ierr) return; 537 } 538 539 PETSC_EXTERN void PETSC_STDCALL matdensegetarrayread_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr) 540 { 541 const PetscScalar *mm; 542 PetscInt m,n; 543 544 *ierr = MatDenseGetArrayRead(*mat,&mm); if (*ierr) return; 545 *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return; 546 *ierr = PetscScalarAddressToFortran((PetscObject)*mat,1,fa,(PetscScalar*)mm,m*n,ia); if (*ierr) return; 547 } 548 549 550 PETSC_EXTERN void PETSC_STDCALL matdenserestorearrayread_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr) 551 { 552 const PetscScalar *lx; 553 PetscInt m,n; 554 555 *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return; 556 *ierr = PetscScalarAddressFromFortran((PetscObject)*mat,fa,*ia,m*n,(PetscScalar**)&lx);if (*ierr) return; 557 *ierr = MatDenseRestoreArrayRead(*mat,&lx);if (*ierr) return; 558 } 559 560 PETSC_EXTERN void PETSC_STDCALL matfactorgetsolverpackage_(Mat *mat,char* name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 561 { 562 const char *tname; 563 564 *ierr = MatFactorGetSolverType(*mat,&tname);if (*ierr) return; 565 if (name != PETSC_NULL_CHARACTER_Fortran) { 566 *ierr = PetscStrncpy(name,tname,len);if (*ierr) return; 567 } 568 FIXRETURNCHAR(PETSC_TRUE,name,len); 569 } 570 571 PETSC_EXTERN void PETSC_STDCALL matgetfactor_(Mat *mat,char* outtype PETSC_MIXED_LEN(len),MatFactorType *ftype,Mat *M,PetscErrorCode *ierr PETSC_END_LEN(len)) 572 { 573 char *t; 574 FIXCHAR(outtype,len,t); 575 *ierr = MatGetFactor(*mat,t,*ftype,M); 576 FREECHAR(outtype,t); 577 } 578 579 PETSC_EXTERN void PETSC_STDCALL matconvert_(Mat *mat,char* outtype PETSC_MIXED_LEN(len),MatReuse *reuse,Mat *M,PetscErrorCode *ierr PETSC_END_LEN(len)) 580 { 581 char *t; 582 FIXCHAR(outtype,len,t); 583 *ierr = MatConvert(*mat,t,*reuse,M); 584 FREECHAR(outtype,t); 585 } 586 587 /* 588 MatCreateSubmatrices() is slightly different from C since the 589 Fortran provides the array to hold the submatrix objects,while in C that 590 array is allocated by the MatCreateSubmatrices() 591 */ 592 PETSC_EXTERN void PETSC_STDCALL matcreatesubmatrices_(Mat *mat,PetscInt *n,IS *isrow,IS *iscol,MatReuse *scall,Mat *smat,PetscErrorCode *ierr) 593 { 594 Mat *lsmat; 595 PetscInt i; 596 597 if (*scall == MAT_INITIAL_MATRIX) { 598 *ierr = MatCreateSubMatrices(*mat,*n,isrow,iscol,*scall,&lsmat); 599 for (i=0; i<=*n; i++) { /* lsmat[*n] might be a dummy matrix for saving data struc */ 600 smat[i] = lsmat[i]; 601 } 602 *ierr = PetscFree(lsmat); 603 } else { 604 *ierr = MatCreateSubMatrices(*mat,*n,isrow,iscol,*scall,&smat); 605 } 606 } 607 608 /* 609 MatDestroyMatrices() is slightly different from C since the 610 Fortran does not free the array of matrix objects, while in C that 611 the array is freed 612 */ 613 PETSC_EXTERN void PETSC_STDCALL matdestroymatrices_(PetscInt *n,Mat *smat,PetscErrorCode *ierr) 614 { 615 PetscInt i; 616 617 for (i=0; i<*n; i++) { 618 *ierr = MatDestroy(&smat[i]);if (*ierr) return; 619 } 620 } 621 622 /* 623 MatDestroySubMatrices() is slightly different from C since the 624 Fortran provides the array to hold the submatrix objects, while in C that 625 array is allocated by the MatCreateSubmatrices() 626 */ 627 PETSC_EXTERN void PETSC_STDCALL matdestroysubmatrices_(PetscInt *n,Mat *smat,PetscErrorCode *ierr) 628 { 629 Mat *lsmat; 630 PetscInt i; 631 632 *ierr = PetscMalloc1(*n+1,&lsmat); 633 for (i=0; i<=*n; i++) { 634 lsmat[i] = smat[i]; 635 } 636 *ierr = MatDestroySubMatrices(*n,&lsmat); 637 } 638 639 PETSC_EXTERN void PETSC_STDCALL matsetoptionsprefix_(Mat *mat,char* prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 640 { 641 char *t; 642 643 FIXCHAR(prefix,len,t); 644 *ierr = MatSetOptionsPrefix(*mat,t); 645 FREECHAR(prefix,t); 646 } 647 648 PETSC_EXTERN void PETSC_STDCALL matnullspaceremove_(MatNullSpace *sp,Vec *vec,PetscErrorCode *ierr) 649 { 650 CHKFORTRANNULLOBJECT(*sp) 651 *ierr = MatNullSpaceRemove(*sp,*vec); 652 } 653 654 PETSC_EXTERN void PETSC_STDCALL matgetinfo_(Mat *mat,MatInfoType *flag,MatInfo *info, int *ierr) 655 { 656 *ierr = MatGetInfo(*mat,*flag,info); 657 } 658 659 PETSC_EXTERN void PETSC_STDCALL matlufactor_(Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr) 660 { 661 *ierr = MatLUFactor(*mat,*row,*col,info); 662 } 663 664 PETSC_EXTERN void PETSC_STDCALL matilufactor_(Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr) 665 { 666 *ierr = MatILUFactor(*mat,*row,*col,info); 667 } 668 669 PETSC_EXTERN void PETSC_STDCALL matlufactorsymbolic_(Mat *fact,Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr) 670 { 671 *ierr = MatLUFactorSymbolic(*fact,*mat,*row,*col,info); 672 } 673 674 PETSC_EXTERN void PETSC_STDCALL matlufactornumeric_(Mat *fact,Mat *mat,const MatFactorInfo *info, int *ierr) 675 { 676 *ierr = MatLUFactorNumeric(*fact,*mat,info); 677 } 678 679 PETSC_EXTERN void PETSC_STDCALL matcholeskyfactor_(Mat *mat,IS *perm,const MatFactorInfo *info, int *ierr) 680 { 681 *ierr = MatCholeskyFactor(*mat,*perm,info); 682 } 683 684 PETSC_EXTERN void PETSC_STDCALL matcholeskyfactorsymbolic_(Mat *fact,Mat *mat,IS *perm,const MatFactorInfo *info, int *ierr) 685 { 686 *ierr = MatCholeskyFactorSymbolic(*fact,*mat,*perm,info); 687 } 688 689 PETSC_EXTERN void PETSC_STDCALL matcholeskyfactornumeric_(Mat *fact,Mat *mat,const MatFactorInfo *info, int *ierr) 690 { 691 *ierr = MatCholeskyFactorNumeric(*fact,*mat,info); 692 } 693 694 PETSC_EXTERN void PETSC_STDCALL matilufactorsymbolic_(Mat *fact,Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr) 695 { 696 *ierr = MatILUFactorSymbolic(*fact,*mat,*row,*col,info); 697 } 698 699 PETSC_EXTERN void PETSC_STDCALL maticcfactorsymbolic_(Mat *fact,Mat *mat,IS *perm,const MatFactorInfo *info, int *ierr) 700 { 701 *ierr = MatICCFactorSymbolic(*fact,*mat,*perm,info); 702 } 703 704 PETSC_EXTERN void PETSC_STDCALL maticcfactor_(Mat *mat,IS *row,const MatFactorInfo *info, int *ierr) 705 { 706 *ierr = MatICCFactor(*mat,*row,info); 707 } 708 709 PETSC_EXTERN void PETSC_STDCALL matfactorinfoinitialize_(MatFactorInfo *info, int *ierr) 710 { 711 *ierr = MatFactorInfoInitialize(info); 712 } 713