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