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