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