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