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