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