Actual source code: zmat.c
1: /*$Id: zmat.c,v 1.100 2001/08/07 03:05:11 balay Exp $*/
3: #include src/mat/impls/adj/mpi/mpiadj.h
4: #include src/fortran/custom/zpetsc.h
5: #include petscmat.h
7: #ifdef PETSC_HAVE_FORTRAN_CAPS
8: #define matsettype_ MATSETTYPE
9: #define matmpiaijgetseqaij_ MATMPIAIJGETSEQAIJ
10: #define matmpibaijgetseqbaij_ MATMPIBAIJGETSEQBAIJ
11: #define matgetrowij_ MATGETROWIJ
12: #define matrestorerowij_ MATRESTOREROWIJ
13: #define matsetfromoptions_ MATSETFROMOPTIONS
14: #define matcreateseqaijwitharrays_ MATCREATESEQAIJWITHARRAYS
15: #define matpartitioningdestroy_ MATPARTITIONINGDESTROY
16: #define matsetvalue_ MATSETVALUE
17: #define matsetvaluelocal_ MATSETVALUELOCAL
18: #define matgetrow_ MATGETROW
19: #define matrestorerow_ MATRESTOREROW
20: #define matgetordering_ MATGETORDERING
21: #define matdestroy_ MATDESTROY
22: #define matcreatempiaij_ MATCREATEMPIAIJ
23: #define matcreateseqaij_ MATCREATESEQAIJ
24: #define matcreatempibaij_ MATCREATEMPIBAIJ
25: #define matcreateseqbaij_ MATCREATESEQBAIJ
26: #define matcreate_ MATCREATE
27: #define matcreateshell_ MATCREATESHELL
28: #define matorderingregisterdestroy_ MATORDERINGREGISTERDESTROY
29: #define matcreatempirowbs_ MATCREATEMPIROWBS
30: #define matcreateseqbdiag_ MATCREATESEQBDIAG
31: #define matcreatempibdiag_ MATCREATEMPIBDIAG
32: #define matcreateseqdense_ MATCREATESEQDENSE
33: #define matcreatempidense_ MATCREATEMPIDENSE
34: #define matconvert_ MATCONVERT
35: #define matload_ MATLOAD
36: #define mattranspose_ MATTRANSPOSE
37: #define matgetarray_ MATGETARRAY
38: #define matrestorearray_ MATRESTOREARRAY
39: #define matgettype_ MATGETTYPE
40: #define matgetinfo_ MATGETINFO
41: #define matshellsetoperation_ MATSHELLSETOPERATION
42: #define matview_ MATVIEW
43: #define matfdcoloringcreate_ MATFDCOLORINGCREATE
44: #define matfdcoloringdestroy_ MATFDCOLORINGDESTROY
45: #define matfdcoloringsetfunctionsnes_ MATFDCOLORINGSETFUNCTIONSNES
46: #define matfdcoloringsetfunctionts_ MATFDCOLORINGSETFUNCTIONTS
47: #define matcopy_ MATCOPY
48: #define matgetsubmatrices_ MATGETSUBMATRICES
49: #define matgetcoloring_ MATGETCOLORING
50: #define matpartitioningsettype_ MATPARTITIONINGSETTYPE
51: #define matduplicate_ MATDUPLICATE
52: #define matzerorows_ MATZEROROWS
53: #define matzerorowslocal_ MATZEROROWSLOCAL
54: #define matpartitioningview_ MATPARTITIONINGVIEW
55: #define matpartitioningcreate_ MATPARTITIONINGCREATE
56: #define matpartitioningsetadjacency_ MATPARTITIONINGSETADJACENCY
57: #define matpartitioningapply_ MATPARTITIONINGAPPLY
58: #define matcreatempiadj_ MATCREATEMPIADJ
59: #define matsetvaluesstencil_ MATSETVALUESSTENCIL
60: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
61: #define matsettype_ matsettype
62: #define matmpiaijgetseqaij_ matmpiaijgetseqaij
63: #define matmpibaijgetseqbaij_ matmpibaijgetseqbaij
64: #define matrestorerowij_ matrestorerowij
65: #define matgetrowij_ matgetrowij
66: #define matcreateseqaijwitharrays_ matcreateseqaijwitharrays
67: #define matpartitioningdestroy_ matpartitioningdestroy
68: #define matpartitioningsettype_ matpartitioningsettype
69: #define matsetvalue_ matsetvalue
70: #define matsetvaluelocal_ matsetvaluelocal
71: #define matgetrow_ matgetrow
72: #define matrestorerow_ matrestorerow
73: #define matview_ matview
74: #define matgetinfo_ matgetinfo
75: #define matgettype_ matgettype
76: #define matdestroy_ matdestroy
77: #define matcreatempiaij_ matcreatempiaij
78: #define matcreateseqaij_ matcreateseqaij
79: #define matcreatempibaij_ matcreatempibaij
80: #define matcreateseqbaij_ matcreateseqbaij
81: #define matcreate_ matcreate
82: #define matcreateshell_ matcreateshell
83: #define matorderingregisterdestroy_ matorderingregisterdestroy
84: #define matgetordering_ matgetordering
85: #define matcreatempirowbs_ matcreatempirowbs
86: #define matcreateseqbdiag_ matcreateseqbdiag
87: #define matcreatempibdiag_ matcreatempibdiag
88: #define matcreateseqdense_ matcreateseqdense
89: #define matcreatempidense_ matcreatempidense
90: #define matconvert_ matconvert
91: #define matload_ matload
92: #define mattranspose_ mattranspose
93: #define matgetarray_ matgetarray
94: #define matrestorearray_ matrestorearray
95: #define matshellsetoperation_ matshellsetoperation
96: #define matfdcoloringcreate_ matfdcoloringcreate
97: #define matfdcoloringdestroy_ matfdcoloringdestroy
98: #define matfdcoloringsetfunctionsnes_ matfdcoloringsetfunctionsnes
99: #define matfdcoloringsetfunctionts_ matfdcoloringsetfunctionts
100: #define matcopy_ matcopy
101: #define matgetsubmatrices_ matgetsubmatrices
102: #define matgetcoloring_ matgetcoloring
103: #define matduplicate_ matduplicate
104: #define matzerorows_ matzerorows
105: #define matzerorowslocal_ matzerorowslocal
106: #define matpartitioningview_ matpartitioningview
107: #define matpartitioningcreate_ matpartitioningcreate
108: #define matpartitioningsetadjacency_ matpartitioningsetadjacency
109: #define matpartitioningapply_ matpartitioningapply
110: #define matcreatempiadj_ matcreatempiadj
111: #define matsetfromoptions_ matsetfromoptions
112: #define matsetvaluesstencil_ matsetvaluesstencil
113: #endif
115: /* The following variables have to be declared outsize EXTERN_C stuff - otherwise MS compilers are unhappy */
116: extern int *uglyrmapd,*uglyrmapo;
118: EXTERN_C_BEGIN
120: void PETSC_STDCALL matsettype_(Mat *x,CHAR type_name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
121: {
122: char *t;
124: FIXCHAR(type_name,len,t);
125: *MatSetType(*x,t);
126: FREECHAR(type_name,t);
127: }
129: void PETSC_STDCALL matsetvaluesstencil_(Mat *mat,int *m,MatStencil *idxm,int *n,MatStencil *idxn,PetscScalar *v,InsertMode *addv,
130: int *ierr)
131: {
132: *MatSetValuesStencil(*mat,*m,idxm,*n,idxn,v,*addv);
133: }
135: void PETSC_STDCALL matmpiaijgetseqaij_(Mat *A,Mat *Ad,Mat *Ao,int *ic,long *iic,int *ierr)
136: {
137: int *i;
138: *MatMPIAIJGetSeqAIJ(*A,Ad,Ao,&i);if (*ierr) return;
139: *iic = PetscIntAddressToFortran(ic,i);
140: }
142: void PETSC_STDCALL matmpibaijgetseqbaij_(Mat *A,Mat *Ad,Mat *Ao,int *ic,long *iic,int *ierr)
143: {
144: int *i;
145: *MatMPIBAIJGetSeqBAIJ(*A,Ad,Ao,&i);if (*ierr) return;
146: *iic = PetscIntAddressToFortran(ic,i);
147: }
149: void PETSC_STDCALL matgetrowij_(Mat *B,int *shift,PetscTruth *sym,int *n,int *ia,long *iia,int *ja,long *jja,
150: PetscTruth *done,int *ierr)
151: {
152: int *IA,*JA;
153: *MatGetRowIJ(*B,*shift,*sym,n,&IA,&JA,done);if (*ierr) return;
154: *iia = PetscIntAddressToFortran(ia,IA);
155: *jja = PetscIntAddressToFortran(ja,JA);
156: }
158: void PETSC_STDCALL matrestorerowij_(Mat *B,int *shift,PetscTruth *sym,int *n,int *ia,long *iia,int *ja,long *jja,
159: PetscTruth *done,int *ierr)
160: {
161: int *IA = PetscIntAddressFromFortran(ia,*iia),*JA = PetscIntAddressFromFortran(ja,*jja);
162: *MatRestoreRowIJ(*B,*shift,*sym,n,&IA,&JA,done);
163: }
165: void PETSC_STDCALL matsetfromoptions_(Mat *B,int *ierr)
166: {
167: *MatSetFromOptions(*B);
168: }
170: void PETSC_STDCALL matcreateseqaijwitharrays_(MPI_Comm *comm,int *m,int *n,int *i,int *j,PetscScalar *a,Mat *mat,int *ierr)
171: {
172: *MatCreateSeqAIJWithArrays((MPI_Comm)PetscToPointerComm(*comm),*m,*n,i,j,a,mat);
173: }
175: void PETSC_STDCALL matcreatempiadj_(MPI_Comm *comm,int *m,int *n,int *i,int *j,int *values,Mat *A,int *ierr)
176: {
177: Mat_MPIAdj *adj;
179: CHKFORTRANNULLINTEGER(values);
180: *MatCreateMPIAdj((MPI_Comm)PetscToPointerComm(*comm),*m,*n,i,j,values,A);
181: adj = (Mat_MPIAdj*)(*A)->data;
182: adj->freeaij = PETSC_FALSE;
183: }
185: void PETSC_STDCALL matpartitioningdestroy_(MatPartitioning *part,int *ierr)
186: {
187: *MatPartitioningDestroy(*part);
188: }
190: void PETSC_STDCALL matpartitioningcreate_(MPI_Comm *comm,MatPartitioning *part, int *ierr)
191: {
192: *MatPartitioningCreate((MPI_Comm)PetscToPointerComm(*comm),part);
193: }
195: void PETSC_STDCALL matpartitioningapply_(MatPartitioning *part,IS *is,int *ierr)
196: {
197: *MatPartitioningApply(*part,is);
198: }
200: void PETSC_STDCALL matpartitioningsetadjacency_(MatPartitioning *part,Mat *mat,int *ierr)
201: {
202: *MatPartitioningSetAdjacency(*part,*mat);
203: }
205: void PETSC_STDCALL matpartitioningview_(MatPartitioning *part,PetscViewer *viewer, int *ierr)
206: {
207: PetscViewer v;
208: PetscPatchDefaultViewers_Fortran(viewer,v);
209: *MatPartitioningView(*part,v);
210: }
212: void PETSC_STDCALL matpartitioningsettype_(MatPartitioning *part,CHAR type PETSC_MIXED_LEN(len),
213: int *ierr PETSC_END_LEN(len))
214: {
215: char *t;
216: FIXCHAR(type,len,t);
217: *MatPartitioningSetType(*part,t);
218: FREECHAR(type,t);
219: }
221: void PETSC_STDCALL matgetcoloring_(Mat *mat,CHAR type PETSC_MIXED_LEN(len),ISColoring *iscoloring,
222: int *ierr PETSC_END_LEN(len))
223: {
224: char *t;
225: FIXCHAR(type,len,t);
226: *MatGetColoring(*mat,t,iscoloring);
227: FREECHAR(type,t);
228: }
230: void PETSC_STDCALL matsetvalue_(Mat *mat,int *i,int *j,PetscScalar *va,InsertMode *mode,int *ierr)
231: {
232: /* cannot use MatSetValue() here since that usesCHKERRQ() which has a return in it */
233: *MatSetValues(*mat,1,i,1,j,va,*mode);
234: }
236: void PETSC_STDCALL matsetvaluelocal_(Mat *mat,int *i,int *j,PetscScalar *va,InsertMode *mode,int *ierr)
237: {
238: /* cannot use MatSetValueLocal() here since that usesCHKERRQ() which has a return in it */
239: *MatSetValuesLocal(*mat,1,i,1,j,va,*mode);
240: }
242: void PETSC_STDCALL matfdcoloringcreate_(Mat *mat,ISColoring *iscoloring,MatFDColoring *color,int *ierr)
243: {
244: *MatFDColoringCreate(*mat,*iscoloring,color);
245: }
247: /*
248: This is a poor way of storing the column and value pointers
249: generated by MatGetRow() to be returned with MatRestoreRow()
250: but there is not natural,good place else to store them. Hence
251: Fortran programmers can only have one outstanding MatGetRows()
252: at a time.
253: */
254: static int matgetrowactive = 0,*my_ocols = 0;
255: static PetscScalar *my_ovals = 0;
257: void PETSC_STDCALL matgetrow_(Mat *mat,int *row,int *ncols,int *cols,PetscScalar *vals,int *ierr)
258: {
259: int **oocols = &my_ocols;
260: PetscScalar **oovals = &my_ovals;
262: if (matgetrowactive) {
263: PetscError(__LINE__,"MatGetRow_Fortran",__FILE__,__SDIR__,1,0,
264: "Cannot have two MatGetRow() active simultaneouslyn
265: call MatRestoreRow() before calling MatGetRow() a second time");
266: *1;
267: return;
268: }
270: CHKFORTRANNULLINTEGER(cols);
271: CHKFORTRANNULLSCALAR(vals);
273: *MatGetRow(*mat,*row,ncols,oocols,oovals);
274: if (*ierr) return;
276: if (oocols) { *PetscMemcpy(cols,my_ocols,(*ncols)*sizeof(int)); if (*ierr) return;}
277: if (oovals) { *PetscMemcpy(vals,my_ovals,(*ncols)*sizeof(PetscScalar)); if (*ierr) return; }
278: matgetrowactive = 1;
279: }
281: void PETSC_STDCALL matrestorerow_(Mat *mat,int *row,int *ncols,int *cols,PetscScalar *vals,int *ierr)
282: {
283: int **oocols = &my_ocols;
284: PetscScalar **oovals = &my_ovals;
285: if (!matgetrowactive) {
286: PetscError(__LINE__,"MatRestoreRow_Fortran",__FILE__,__SDIR__,1,0,
287: "Must call MatGetRow() first");
288: *1;
289: return;
290: }
291: CHKFORTRANNULLINTEGER(cols);
292: CHKFORTRANNULLSCALAR(vals);
293: *MatRestoreRow(*mat,*row,ncols,oocols,oovals);
294: matgetrowactive = 0;
295: }
297: void PETSC_STDCALL matview_(Mat *mat,PetscViewer *vin,int *ierr)
298: {
299: PetscViewer v;
300: PetscPatchDefaultViewers_Fortran(vin,v);
301: *MatView(*mat,v);
302: }
304: void PETSC_STDCALL matcopy_(Mat *A,Mat *B,MatStructure *str,int *ierr)
305: {
306: *MatCopy(*A,*B,*str);
307: }
309: void PETSC_STDCALL matgetinfo_(Mat *mat,MatInfoType *flag,double *finfo,int *ierr)
310: {
311: *MatGetInfo(*mat,*flag,(MatInfo*)finfo);
312: }
314: void PETSC_STDCALL matgetarray_(Mat *mat,PetscScalar *fa,long *ia,int *ierr)
315: {
316: PetscScalar *mm;
317: int m,n;
319: *MatGetArray(*mat,&mm); if (*ierr) return;
320: *MatGetSize(*mat,&m,&n); if (*ierr) return;
321: *PetscScalarAddressToFortran((PetscObject)*mat,fa,mm,m*n,ia); if (*ierr) return;
322: }
324: void PETSC_STDCALL matrestorearray_(Mat *mat,PetscScalar *fa,long *ia,int *ierr)
325: {
326: PetscScalar *lx;
327: int m,n;
329: *MatGetSize(*mat,&m,&n); if (*ierr) return;
330: *PetscScalarAddressFromFortran((PetscObject)*mat,fa,*ia,m*n,&lx);if (*ierr) return;
331: *MatRestoreArray(*mat,&lx);if (*ierr) return;
332: }
334: void PETSC_STDCALL mattranspose_(Mat *mat,Mat *B,int *ierr)
335: {
336: CHKFORTRANNULLINTEGER(B);
337: *MatTranspose(*mat,B);
338: }
340: void PETSC_STDCALL matload_(PetscViewer *viewer,CHAR outtype PETSC_MIXED_LEN(len),Mat *newmat,int *ierr PETSC_END_LEN(len))
341: {
342: char *t;
343: PetscViewer v;
344: FIXCHAR(outtype,len,t);
345: PetscPatchDefaultViewers_Fortran(viewer,v);
346: *MatLoad(v,t,newmat);
347: FREECHAR(outtype,t);
348: }
350: void PETSC_STDCALL matconvert_(Mat *mat,CHAR outtype PETSC_MIXED_LEN(len),Mat *M,int *ierr PETSC_END_LEN(len))
351: {
352: char *t;
353: FIXCHAR(outtype,len,t);
354: *MatConvert(*mat,t,M);
355: FREECHAR(outtype,t);
356: }
358: void PETSC_STDCALL matcreateseqdense_(MPI_Comm *comm,int *m,int *n,PetscScalar *data,Mat *newmat,int *ierr)
359: {
360: CHKFORTRANNULLSCALAR(data);
361: *MatCreateSeqDense((MPI_Comm)PetscToPointerComm(*comm),*m,*n,data,newmat);
362: }
364: void PETSC_STDCALL matcreatempidense_(MPI_Comm *comm,int *m,int *n,int *M,int *N,PetscScalar *data,Mat *newmat,
365: int *ierr)
366: {
367: CHKFORTRANNULLSCALAR(data);
368: *MatCreateMPIDense((MPI_Comm)PetscToPointerComm(*comm),*m,*n,*M,*N,data,newmat);
369: }
371: /* Fortran ignores diagv */
372: void PETSC_STDCALL matcreatempibdiag_(MPI_Comm *comm,int *m,int *M,int *N,int *nd,int *bs,
373: int *diag,PetscScalar **diagv,Mat *newmat,int *ierr)
374: {
375: *MatCreateMPIBDiag((MPI_Comm)PetscToPointerComm(*comm),
376: *m,*M,*N,*nd,*bs,diag,PETSC_NULL,newmat);
377: }
379: /* Fortran ignores diagv */
380: void PETSC_STDCALL matcreateseqbdiag_(MPI_Comm *comm,int *m,int *n,int *nd,int *bs,
381: int *diag,PetscScalar **diagv,Mat *newmat,int *ierr)
382: {
383: *MatCreateSeqBDiag((MPI_Comm)PetscToPointerComm(*comm),*m,*n,*nd,*bs,diag,
384: PETSC_NULL,newmat);
385: }
387: #if defined(PETSC_HAVE_BLOCKSOLVE) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
388: /* Fortran cannot pass in procinfo,hence ignored */
389: void PETSC_STDCALL matcreatempirowbs_(MPI_Comm *comm,int *m,int *M,int *nz,int *nnz,Mat *newmat,int *ierr)
390: {
391: CHKFORTRANNULLINTEGER(nnz);
392: *MatCreateMPIRowbs((MPI_Comm)PetscToPointerComm(*comm),*m,*M,*nz,nnz,newmat);
393: }
394: #endif
396: void PETSC_STDCALL matgetordering_(Mat *mat,CHAR type PETSC_MIXED_LEN(len),IS *rperm,IS *cperm,
397: int *ierr PETSC_END_LEN(len))
398: {
399: char *t;
400: FIXCHAR(type,len,t);
401: *MatGetOrdering(*mat,t,rperm,cperm);
402: FREECHAR(type,t);
403: }
405: void PETSC_STDCALL matorderingregisterdestroy_(int *ierr)
406: {
407: *MatOrderingRegisterDestroy();
408: }
410: void PETSC_STDCALL matgettype_(Mat *mm,CHAR name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
411: {
412: char *tname;
414: *MatGetType(*mm,&tname);
415: #if defined(PETSC_USES_CPTOFCD)
416: {
417: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
418: if (t != PETSC_NULL_CHARACTER_Fortran) {
419: *PetscStrncpy(t,tname,len1);if (*ierr) return;
420: }
421: }
422: #else
423: if (name != PETSC_NULL_CHARACTER_Fortran) {
424: *PetscStrncpy(name,tname,len);if (*ierr) return;
425: }
426: #endif
427: }
429: void PETSC_STDCALL matcreate_(MPI_Comm *comm,int *m,int *n,int *M,int *N,Mat *V,int *ierr)
430: {
431: *MatCreate((MPI_Comm)PetscToPointerComm(*comm),*m,*n,*M,*N,V);
432: }
434: void PETSC_STDCALL matcreateseqaij_(MPI_Comm *comm,int *m,int *n,int *nz,
435: int *nnz,Mat *newmat,int *ierr)
436: {
437: CHKFORTRANNULLINTEGER(nnz);
438: *MatCreateSeqAIJ((MPI_Comm)PetscToPointerComm(*comm),*m,*n,*nz,nnz,newmat);
439: }
441: void PETSC_STDCALL matcreateseqbaij_(MPI_Comm *comm,int *bs,int *m,int *n,int *nz,
442: int *nnz,Mat *newmat,int *ierr)
443: {
444: CHKFORTRANNULLINTEGER(nnz);
445: *MatCreateSeqBAIJ((MPI_Comm)PetscToPointerComm(*comm),*bs,*m,*n,*nz,nnz,newmat);
446: }
448: void PETSC_STDCALL matfdcoloringdestroy_(MatFDColoring *mat,int *ierr)
449: {
450: *MatFDColoringDestroy(*mat);
451: }
453: void PETSC_STDCALL matdestroy_(Mat *mat,int *ierr)
454: {
455: *MatDestroy(*mat);
456: }
458: void PETSC_STDCALL matcreatempiaij_(MPI_Comm *comm,int *m,int *n,int *M,int *N,
459: int *d_nz,int *d_nnz,int *o_nz,int *o_nnz,Mat *newmat,int *ierr)
460: {
461: CHKFORTRANNULLINTEGER(d_nnz);
462: CHKFORTRANNULLINTEGER(o_nnz);
464: *MatCreateMPIAIJ((MPI_Comm)PetscToPointerComm(*comm),
465: *m,*n,*M,*N,*d_nz,d_nnz,*o_nz,o_nnz,newmat);
466: }
467: void PETSC_STDCALL matcreatempibaij_(MPI_Comm *comm,int *bs,int *m,int *n,int *M,int *N,
468: int *d_nz,int *d_nnz,int *o_nz,int *o_nnz,Mat *newmat,int *ierr)
469: {
470: CHKFORTRANNULLINTEGER(d_nnz);
471: CHKFORTRANNULLINTEGER(o_nnz);
472: *MatCreateMPIBAIJ((MPI_Comm)PetscToPointerComm(*comm),
473: *bs,*m,*n,*M,*N,*d_nz,d_nnz,*o_nz,o_nnz,newmat);
474: }
477: /*
478: The MatShell Matrix Vector product requires a C routine.
479: This C routine then calls the corresponding Fortran routine that was
480: set by the user.
481: */
482: void PETSC_STDCALL matcreateshell_(MPI_Comm *comm,int *m,int *n,int *M,int *N,void **ctx,Mat *mat,int *ierr)
483: {
484: *MatCreateShell((MPI_Comm)PetscToPointerComm(*comm),*m,*n,*M,*N,*ctx,mat);
485: if (*ierr) return;
486: *PetscMalloc(4*sizeof(void *),&((PetscObject)*mat)->fortran_func_pointers);
487: }
489: static int ourmult(Mat mat,Vec x,Vec y)
490: {
491: int 0;
492: (*(int (PETSC_STDCALL *)(Mat*,Vec*,Vec*,int*))(((PetscObject)mat)->fortran_func_pointers[0]))(&mat,&x,&y,&ierr);
493: return ierr;
494: }
496: static int ourmulttranspose(Mat mat,Vec x,Vec y)
497: {
498: int 0;
499: (*(int (PETSC_STDCALL *)(Mat*,Vec*,Vec*,int*))(((PetscObject)mat)->fortran_func_pointers[2]))(&mat,&x,&y,&ierr);
500: return ierr;
501: }
503: static int ourmultadd(Mat mat,Vec x,Vec y,Vec z)
504: {
505: int 0;
506: (*(int (PETSC_STDCALL *)(Mat*,Vec*,Vec*,Vec*,int*))(((PetscObject)mat)->fortran_func_pointers[1]))(&mat,&x,&y,&z,&ierr);
507: return ierr;
508: }
510: static int ourmulttransposeadd(Mat mat,Vec x,Vec y,Vec z)
511: {
512: int 0;
513: (*(int (PETSC_STDCALL *)(Mat*,Vec*,Vec*,Vec*,int*))(((PetscObject)mat)->fortran_func_pointers[3]))(&mat,&x,&y,&z,&ierr);
514: return ierr;
515: }
517: void PETSC_STDCALL matshellsetoperation_(Mat *mat,MatOperation *op,int (PETSC_STDCALL *f)(Mat*,Vec*,Vec*,int*),int *ierr)
518: {
519: if (*op == MATOP_MULT) {
520: *MatShellSetOperation(*mat,*op,(void(*)(void))ourmult);
521: ((PetscObject)*mat)->fortran_func_pointers[0] = (void(*)(void))f;
522: } else if (*op == MATOP_MULT_TRANSPOSE) {
523: *MatShellSetOperation(*mat,*op,(void(*)(void))ourmulttranspose);
524: ((PetscObject)*mat)->fortran_func_pointers[2] = (void(*)(void))f;
525: } else if (*op == MATOP_MULT_ADD) {
526: *MatShellSetOperation(*mat,*op,(void(*)(void))ourmultadd);
527: ((PetscObject)*mat)->fortran_func_pointers[1] = (void(*)(void))f;
528: } else if (*op == MATOP_MULT_TRANSPOSE_ADD) {
529: *MatShellSetOperation(*mat,*op,(void(*)(void))ourmulttransposeadd);
530: ((PetscObject)*mat)->fortran_func_pointers[3] = (void(*)(void))f;
531: } else {
532: PetscError(__LINE__,"MatShellSetOperation_Fortran",__FILE__,__SDIR__,1,0,
533: "Cannot set that matrix operation");
534: *1;
535: }
536: }
538: #include petscts.h
539: /*
540: MatFDColoringSetFunction sticks the Fortran function into the fortran_func_pointers
541: this function is then accessed by ourmatfdcoloringfunction()
543: NOTE: FORTRAN USER CANNOT PUT IN A NEW J OR B currently.
545: USER CAN HAVE ONLY ONE MatFDColoring in code Because there is no place to hang f7!
546: */
548: static void (PETSC_STDCALL *f7)(TS*,double*,Vec*,Vec*,void*,int*);
550: static int ourmatfdcoloringfunctionts(TS ts,double t,Vec x,Vec y,void *ctx)
551: {
552: int 0;
553: (*f7)(&ts,&t,&x,&y,ctx,&ierr);
554: return ierr;
555: }
557: void PETSC_STDCALL matfdcoloringsetfunctionts_(MatFDColoring *fd,void (PETSC_STDCALL *f)(TS*,double*,Vec*,Vec*,void*,int*),
558: void *ctx,int *ierr)
559: {
560: f7 = f;
561: *MatFDColoringSetFunction(*fd,(int (*)(void))ourmatfdcoloringfunctionts,ctx);
562: }
564: static void (PETSC_STDCALL *f8)(SNES*,Vec*,Vec*,void*,int*);
566: static int ourmatfdcoloringfunctionsnes(SNES ts,Vec x,Vec y,void *ctx)
567: {
568: int 0;
569: (*f8)(&ts,&x,&y,ctx,&ierr);
570: return ierr;
571: }
574: void PETSC_STDCALL matfdcoloringsetfunctionsnes_(MatFDColoring *fd,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec*,void*,int*),
575: void *ctx,int *ierr)
576: {
577: f8 = f;
578: *MatFDColoringSetFunction(*fd,(int (*)(void))ourmatfdcoloringfunctionsnes,ctx);
579: }
581: /*
582: MatGetSubmatrices() is slightly different from C since the
583: Fortran provides the array to hold the submatrix objects,while in C that
584: array is allocated by the MatGetSubmatrices()
585: */
586: void PETSC_STDCALL matgetsubmatrices_(Mat *mat,int *n,IS *isrow,IS *iscol,MatReuse *scall,Mat *smat,int *ierr)
587: {
588: Mat *lsmat;
589: int i;
591: if (*scall == MAT_INITIAL_MATRIX) {
592: *MatGetSubMatrices(*mat,*n,isrow,iscol,*scall,&lsmat);
593: for (i=0; i<*n; i++) {
594: smat[i] = lsmat[i];
595: }
596: PetscFree(lsmat);
597: } else {
598: *MatGetSubMatrices(*mat,*n,isrow,iscol,*scall,&smat);
599: }
600: }
602: void PETSC_STDCALL matduplicate_(Mat *matin,MatDuplicateOption *op,Mat *matout,int *ierr)
603: {
604: *MatDuplicate(*matin,*op,matout);
605: }
607: void PETSC_STDCALL matzerorows_(Mat *mat,IS *is,PetscScalar *diag,int *ierr)
608: {
609: CHKFORTRANNULLSCALAR(diag);
610: *MatZeroRows(*mat,*is,diag);
611: }
613: void PETSC_STDCALL matzerorowslocal_(Mat *mat,IS *is,PetscScalar *diag,int *ierr)
614: {
615: CHKFORTRANNULLSCALAR(diag);
616: *MatZeroRowsLocal(*mat,*is,diag);
617: }
619: /* Patch added for Glenn */
620: #ifdef PETSC_HAVE_FORTRAN_CAPS
621: #define matmpibaijdiagonalscalelocal_ MATMPIBAIJDIAGONALSCALELOCAL
622: #define matdiagonalscalelocal_ MATDIAGONALSCALELOCAL
623: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
624: #define matmpibaijdiagonalscalelocal_ matmpibaijdiagonalscalelocal
625: #define matdiagonalscalelocal_ matdiagonalscalelocal
626: #endif
628: void matmpibaijdiagonalscalelocal_(Mat *A,Vec *scale,int *ierr)
629: {
630: if (!uglyrmapd) {
631: *MatMPIBAIJDiagonalScaleLocalSetUp(*A,*scale);
632: if (*ierr) return;
633: }
634: *MatMPIBAIJDiagonalScaleLocal(*A,*scale);
635: }
637: void PETSC_STDCALL matdiagonalscalelocal_(Mat *A,Vec *scale, int *__ierr ){
638: if (!uglyrmapd) {
639: *__MatMPIBAIJDiagonalScaleLocalSetUp(*A,*scale);
640: if (*__ierr) return;
641: }
642: *__MatMPIBAIJDiagonalScaleLocal(*A,*scale);
643: }
645: EXTERN_C_END