xref: /petsc/src/mat/interface/ftn-custom/zmatrixf.c (revision ef0bb6c736604ce380bf8bea4ebd4a7bda431d97)
1 #include <petsc/private/fortranimpl.h>
2 #include <petsc/private/f90impl.h>
3 #include <petscmat.h>
4 #include <petscviewer.h>
5 
6 #if defined(PETSC_HAVE_FORTRAN_CAPS)
7 #define matsetvalues_                    MATSETVALUES
8 #define matsetvaluesnnnn_                MATSETVALUESNNNN
9 #define matsetvalues0_                   MATSETVALUES0
10 #define matsetvaluesnn1_                 MATSETVALUESNN1
11 #define matsetvalues11_                  MATSETVALUES11
12 #define matsetvalues1n_                  MATSETVALUES1N
13 #define matsetvaluesn1_                  MATSETVALUESN1
14 #define matsetvaluesblocked0_            MATSETVALUESBLOCKED0
15 #define matsetvaluesblocked2_            MATSETVALUESBLOCKED2
16 #define matsetvaluesblocked11_           MATSETVALUESBLOCKED11
17 #define matsetvaluesblocked111_          MATSETVALUESBLOCKED111
18 #define matsetvaluesblocked1n_           MATSETVALUESBLOCKED1N
19 #define matsetvaluesblockedn1_           MATSETVALUESBLOCKEDN1
20 #define matsetvaluesblockedlocal_        MATSETVALUESBLOCKEDLOCAL
21 #define matsetvaluesblockedlocal0_       MATSETVALUESBLOCKEDLOCAL0
22 #define matsetvaluesblockedlocal11_      MATSETVALUESBLOCKEDLOCAL11
23 #define matsetvaluesblockedlocal111_     MATSETVALUESBLOCKEDLOCAL111
24 #define matsetvaluesblockedlocal1n_      MATSETVALUESBLOCKEDLOCAL1N
25 #define matsetvaluesblockedlocaln1_      MATSETVALUESBLOCKEDLOCALN1
26 #define matsetvalueslocal_               MATSETVALUESLOCAL
27 #define matsetvalueslocal0_              MATSETVALUESLOCAL0
28 #define matsetvalueslocal11_             MATSETVALUESLOCAL11
29 #define matsetvalueslocal11nn_           MATSETVALUESLOCAL11NN
30 #define matsetvalueslocal111_            MATSETVALUESLOCAL111
31 #define matsetvalueslocal1n_             MATSETVALUESLOCAL1N
32 #define matsetvalueslocaln1_             MATSETVALUESLOCALN1
33 #define matgetrowmin_                    MATGETROWMIN
34 #define matgetrowminabs_                 MATGETROWMINABS
35 #define matgetrowmax_                    MATGETROWMAX
36 #define matgetrowmaxabs_                 MATGETROWMAXABS
37 #define matdestroymatrices_              MATDESTROYMATRICES
38 #define matdestroysubmatrices_           MATDESTROYSUBMATRICES
39 #define matgetfactor_                    MATGETFACTOR
40 #define matfactorgetsolverpackage_       MATFACTORGETSOLVERPACKAGE
41 #define matgetrowij_                     MATGETROWIJ
42 #define matrestorerowij_                 MATRESTOREROWIJ
43 #define matgetrow_                       MATGETROW
44 #define matrestorerow_                   MATRESTOREROW
45 #define matload_                         MATLOAD
46 #define matview_                         MATVIEW
47 #define matseqaijgetarray_               MATSEQAIJGETARRAY
48 #define matseqaijrestorearray_           MATSEQAIJRESTOREARRAY
49 #define matdensegetarray_                MATDENSEGETARRAY
50 #define matdensegetarrayread_            MATDENSEGETARRAYREAD
51 #define matdenserestorearray_            MATDENSERESTOREARRAY
52 #define matdenserestorearrayread_        MATDENSERESTOREARRAYREAD
53 #define matconvert_                      MATCONVERT
54 #define matcreatesubmatrices_            MATCREATESUBMATRICES
55 #define matcreatesubmatricesmpi_         MATCREATESUBMATRICESMPI
56 #define matzerorowscolumns_              MATZEROROWSCOLUMNS
57 #define matzerorowscolumnsis_            MATZEROROWSCOLUMNSIS
58 #define matzerorowsstencil_              MATZEROROWSSTENCIL
59 #define matzerorowscolumnsstencil_       MATZEROROWSCOLUMNSSTENCIL
60 #define matzerorows_                     MATZEROROWS
61 #define matzerorowsis_                   MATZEROROWSIS
62 #define matzerorowslocal_                MATZEROROWSLOCAL
63 #define matzerorowslocal0_               MATZEROROWSLOCAL0
64 #define matzerorowslocal1_               MATZEROROWSLOCAL1
65 #define matzerorowslocalis_              MATZEROROWSLOCALIS
66 #define matzerorowscolumnslocal_         MATZEROROWSCOLUMNSLOCAL
67 #define matzerorowscolumnslocalis_       MATZEROROWSCOLUMNSLOCALIS
68 #define matsetoptionsprefix_             MATSETOPTIONSPREFIX
69 #define matcreatevecs_                   MATCREATEVECS
70 #define matnullspaceremove_              MATNULLSPACEREMOVE
71 #define matgetinfo_                      MATGETINFO
72 #define matlufactor_                     MATLUFACTOR
73 #define matilufactor_                    MATILUFACTOR
74 #define matlufactorsymbolic_             MATLUFACTORSYMBOLIC
75 #define matlufactornumeric_              MATLUFACTORNUMERIC
76 #define matcholeskyfactor_               MATCHOLESKYFACTOR
77 #define matcholeskyfactorsymbolic_       MATCHOLESKYFACTORSYMBOLIC
78 #define matcholeskyfactornumeric_        MATCHOLESKYFACTORNUMERIC
79 #define matilufactorsymbolic_            MATILUFACTORSYMBOLIC
80 #define maticcfactorsymbolic_            MATICCFACTORSYMBOLIC
81 #define maticcfactor_                    MATICCFACTOR
82 #define matfactorinfoinitialize_         MATFACTORINFOINITIALIZE
83 #define matnullspacesetfunction_         MATNULLSPACESETFUNCTION
84 #define matfindnonzerorows_              MATFINDNONZEROROWS
85 #define matgetsize_                      MATGETSIZE
86 #define matgetsize00_                    MATGETSIZE00
87 #define matgetsize10_                    MATGETSIZE10
88 #define matgetsize01_                    MATGETSIZE01
89 #define matgetlocalsize_                 MATGETLOCALSIZE
90 #define matgetlocalsize00_               MATGETLOCALSIZE00
91 #define matgetlocalsize10_               MATGETLOCALSIZE10
92 #define matgetlocalsize01_               MATGETLOCALSIZE01
93 #define matsetnullspace_                 MATSETNULLSPACE
94 #define matgetownershiprange_            MATGETOWNERSHIPRANGE
95 #define matgetownershiprange00_          MATGETOWNERSHIPRANGE00
96 #define matgetownershiprange10_          MATGETOWNERSHIPRANGE10
97 #define matgetownershiprange01_          MATGETOWNERSHIPRANGE01
98 #define matgetownershiprange11_          MATGETOWNERSHIPRANGE11
99 #define matgetownershipis_               MATGETOWNERSHIPIS
100 #define matgetownershiprangecolumn_      MATGETOWNERSHIPRANGECOLUMN
101 #define matviewfromoptions_              MATVIEWFROMOPTIONS
102 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
103 #define matsetvalues_                    matsetvalues
104 #define matsetvaluesnnnn_                matsetvaluesnnnn
105 #define matsetvalues0_                   matsetvalues0
106 #define matsetvaluesnn1_                 matsetvaluesnn1
107 #define matsetvalues11_                  matsetvalues11
108 #define matsetvaluesn1_                  matsetvaluesn1
109 #define matsetvalues1n_                  matsetvalues1n
110 #define matsetvalueslocal_               matsetvalueslocal
111 #define matsetvalueslocal0_              matsetvalueslocal0
112 #define matsetvalueslocal11_             matsetvalueslocal11
113 #define matsetvalueslocal11nn_           matsetvalueslocal11nn
114 #define matsetvalueslocal111_            matsetvalueslocal111
115 #define matsetvalueslocal1n_             matsetvalueslocal1n
116 #define matsetvalueslocaln1_             matsetvalueslocaln1
117 #define matsetvaluesblocked_             matsetvaluesblocked
118 #define matsetvaluesblocked0_            matsetvaluesblocked0
119 #define matsetvaluesblocked2_            matsetvaluesblocked2
120 #define matsetvaluesblocked11_           matsetvaluesblocked11
121 #define matsetvaluesblocked111_          matsetvaluesblocked111
122 #define matsetvaluesblocked1n_           matsetvaluesblocked1n
123 #define matsetvaluesblockedn1_           matsetvaluesblockedn1
124 #define matsetvaluesblockedlocal_        matsetvaluesblockedlocal
125 #define matsetvaluesblockedlocal0_       matsetvaluesblockedlocal0
126 #define matsetvaluesblockedlocal11_      matsetvaluesblockedlocal11
127 #define matsetvaluesblockedlocal111_     matsetvaluesblockedlocal111
128 #define matsetvaluesblockedlocal1n_      matsetvaluesblockedlocal1n
129 #define matsetvaluesblockedlocaln1_      matsetvaluesblockedlocaln1
130 #define matgetrowmin_                    matgetrowmin
131 #define matgetrowminabs_                 matgetrowminabs
132 #define matgetrowmax_                    matgetrowmax
133 #define matgetrowmaxabs_                 matgetrowmaxabs
134 #define matdestroymatrices_              matdestroymatrices
135 #define matdestroysubmatrices_           matdestroysubmatrices
136 #define matgetfactor_                    matgetfactor
137 #define matfactorgetsolverpackage_       matfactorgetsolverpackage
138 #define matcreatevecs_                   matcreatevecs
139 #define matgetrowij_                     matgetrowij
140 #define matrestorerowij_                 matrestorerowij
141 #define matgetrow_                       matgetrow
142 #define matrestorerow_                   matrestorerow
143 #define matview_                         matview
144 #define matload_                         matload
145 #define matseqaijgetarray_               matseqaijgetarray
146 #define matseqaijrestorearray_           matseqaijrestorearray
147 #define matdensegetarray_                matdensegetarray
148 #define matdensegetarrayread_            matdensegetarrayread
149 #define matdenserestorearray_            matdenserestorearray
150 #define matdenserestorearrayread_        matdenserestorearrayread
151 #define matconvert_                      matconvert
152 #define matcreatesubmatrices_            matcreatesubmatrices
153 #define matcreatesubmatricesmpi_         matcreatesubmatricesmpi
154 #define matzerorowscolumns_              matzerorowscolumns
155 #define matzerorowscolumnsis_            matzerorowscolumnsis
156 #define matzerorowsstencil_              matzerorowsstencil
157 #define matzerorowscolumnsstencil_       matzerorowscolumnsstencil
158 #define matzerorows_                     matzerorows
159 #define matzerorowsis_                   matzerorowsis
160 #define matzerorowslocal_                matzerorowslocal
161 #define matzerorowslocalis_              matzerorowslocalis
162 #define matzerorowscolumnslocal_         matzerorowscolumnslocal
163 #define matzerorowscolumnslocalis_       matzerorowscolumnslocalis
164 #define matsetoptionsprefix_             matsetoptionsprefix
165 #define matnullspaceremove_              matnullspaceremove
166 #define matgetinfo_                      matgetinfo
167 #define matlufactor_                     matlufactor
168 #define matilufactor_                    matilufactor
169 #define matlufactorsymbolic_             matlufactorsymbolic
170 #define matlufactornumeric_              matlufactornumeric
171 #define matcholeskyfactor_               matcholeskyfactor
172 #define matcholeskyfactorsymbolic_       matcholeskyfactorsymbolic
173 #define matcholeskyfactornumeric_        matcholeskyfactornumeric
174 #define matilufactorsymbolic_            matilufactorsymbolic
175 #define maticcfactorsymbolic_            maticcfactorsymbolic
176 #define maticcfactor_                    maticcfactor
177 #define matfactorinfoinitialize_         matfactorinfoinitialize
178 #define matnullspacesetfunction_         matnullspacesetfunction
179 #define matfindnonzerorows_              matfindnonzerorows
180 #define matgetsize_                      matgetsize
181 #define matgetsize00_                    matgetsize00
182 #define matgetsize10_                    matgetsize10
183 #define matgetsize01_                    matgetsize01
184 #define matgetlocalsize_                 matgetlocalsize
185 #define matgetlocalsize00_               matgetlocalsize00
186 #define matgetlocalsize10_               matgetlocalsize10
187 #define matgetlocalsize01_               matgetlocalsize01
188 #define matsetnullspace_                 matsetnullspace
189 #define matgetownershiprange_            matgetownershiprange
190 #define matgetownershiprange00_          matgetownershiprange00
191 #define matgetownershiprange10_          matgetownershiprange10
192 #define matgetownershiprange01_          matgetownershiprange01
193 #define matgetownershiprange11_          matgetownershiprange11
194 #define matgetownershipis_               matgetownershipis
195 #define matgetownershiprangecolumn_      matgetownershiprangecolumn
196 #define matviewfromoptions_              matviewfromoptions
197 #endif
198 
199 PETSC_EXTERN void PETSC_STDCALL  matgetownershiprange_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
200 {
201   CHKFORTRANNULLINTEGER(m);
202   CHKFORTRANNULLINTEGER(n);
203   *ierr = MatGetOwnershipRange(*mat,m,n);
204 }
205 
206 PETSC_EXTERN void PETSC_STDCALL  matgetownershiprange00_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
207 {
208   CHKFORTRANNULLINTEGER(m);
209   CHKFORTRANNULLINTEGER(n);
210   *ierr = MatGetOwnershipRange(*mat,m,n);
211 }
212 
213 PETSC_EXTERN void PETSC_STDCALL  matgetownershiprange10_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
214 {
215   CHKFORTRANNULLINTEGER(m);
216   CHKFORTRANNULLINTEGER(n);
217   *ierr = MatGetOwnershipRange(*mat,m,n);
218 }
219 
220 PETSC_EXTERN void PETSC_STDCALL  matgetownershiprange01_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
221 {
222   CHKFORTRANNULLINTEGER(m);
223   CHKFORTRANNULLINTEGER(n);
224   *ierr = MatGetOwnershipRange(*mat,m,n);
225 }
226 
227 PETSC_EXTERN void PETSC_STDCALL  matgetownershiprange11_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
228 {
229   CHKFORTRANNULLINTEGER(m);
230   CHKFORTRANNULLINTEGER(n);
231   *ierr = MatGetOwnershipRange(*mat,m,n);
232 }
233 
234 PETSC_EXTERN void PETSC_STDCALL  matgetownershipis_(Mat *mat,IS *m,IS *n, int *ierr )
235 {
236   CHKFORTRANNULLOBJECT(m);
237   CHKFORTRANNULLOBJECT(n);
238   *ierr = MatGetOwnershipIS(*mat,m,n);
239 }
240 
241 PETSC_EXTERN void PETSC_STDCALL  matgetownershiprangecolumn_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
242 {
243   CHKFORTRANNULLINTEGER(m);
244   CHKFORTRANNULLINTEGER(n);
245   *ierr = MatGetOwnershipRangeColumn(*mat,m,n);
246 }
247 
248 PETSC_EXTERN void PETSC_STDCALL  matgetsize_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
249 {
250   CHKFORTRANNULLINTEGER(m);
251   CHKFORTRANNULLINTEGER(n);
252   *ierr = MatGetSize(*mat,m,n);
253 }
254 
255 PETSC_EXTERN void PETSC_STDCALL  matgetsize00_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
256 {
257   matgetsize_(mat,m,n,ierr);
258 }
259 
260 PETSC_EXTERN void PETSC_STDCALL  matgetsize10_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
261 {
262   matgetsize_(mat,m,n,ierr);
263 }
264 
265 PETSC_EXTERN void PETSC_STDCALL  matgetsize01_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
266 {
267   matgetsize_(mat,m,n,ierr);
268 }
269 
270 PETSC_EXTERN void PETSC_STDCALL  matgetlocalsize_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
271 {
272   CHKFORTRANNULLINTEGER(m);
273   CHKFORTRANNULLINTEGER(n);
274   *ierr = MatGetLocalSize(*mat,m,n);
275 }
276 
277 PETSC_EXTERN void PETSC_STDCALL  matgetlocalsize00_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
278 {
279   matgetlocalsize_(mat,m,n,ierr);
280 }
281 
282 PETSC_EXTERN void PETSC_STDCALL  matgetlocalsize10_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
283 {
284   matgetlocalsize_(mat,m,n,ierr);
285 }
286 
287 PETSC_EXTERN void PETSC_STDCALL  matgetlocalsize01_(Mat *mat,PetscInt *m,PetscInt *n, int *ierr )
288 {
289   matgetlocalsize_(mat,m,n,ierr);
290 }
291 
292 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblocked_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){
293   *ierr = MatSetValuesBlocked(*mat,*m,idxm,*n,idxn,v,*addv);
294 }
295 
296 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblocked2_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], F90Array2d *y,InsertMode *addv, int *ierr PETSC_F90_2PTR_PROTO(ptrd)){
297   PetscScalar *fa;
298   *ierr = F90Array2dAccess(y,MPIU_SCALAR,(void**)&fa PETSC_F90_2PTR_PARAM(ptrd));if (*ierr) return;
299   matsetvaluesblocked_(mat,m,idxm,n,idxn,fa,addv,ierr);
300 }
301 
302 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblocked0_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){
303   matsetvaluesblocked_(mat,m,idxm,n,idxn,v,addv,ierr);
304 }
305 
306 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblocked11_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){
307   matsetvaluesblocked_(mat,m,idxm,n,idxn,v,addv,ierr);
308 }
309 
310 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblocked111_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){
311   matsetvaluesblocked_(mat,m,idxm,n,idxn,v,addv,ierr);
312 }
313 
314 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblocked1n_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){
315   matsetvaluesblocked_(mat,m,idxm,n,idxn,v,addv,ierr);
316 }
317 
318 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblockedn1_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){
319   matsetvaluesblocked_(mat,m,idxm,n,idxn,v,addv,ierr);
320 }
321 
322 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblockedlocal_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr )
323 {
324   *ierr = MatSetValuesBlockedLocal(*mat,*nrow,irow,*ncol,icol,y,*addv);
325 }
326 
327 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblockedlocal0_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){
328   matsetvaluesblockedlocal_(mat,m,idxm,n,idxn,v,addv,ierr);
329 }
330 
331 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblockedlocal11_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){
332   matsetvaluesblockedlocal_(mat,m,idxm,n,idxn,v,addv,ierr);
333 }
334 
335 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblockedlocal111_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){
336   matsetvaluesblockedlocal_(mat,m,idxm,n,idxn,v,addv,ierr);
337 }
338 
339 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblockedlocal1n_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){
340   matsetvaluesblockedlocal_(mat,m,idxm,n,idxn,v,addv,ierr);
341 }
342 
343 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesblockedlocaln1_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr ){
344   matsetvaluesblockedlocal_(mat,m,idxm,n,idxn,v,addv,ierr);
345 }
346 
347 PETSC_EXTERN void PETSC_STDCALL  matsetvalues_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr )
348 {
349   *ierr = MatSetValues(*mat,*m,idxm,*n,idxn,v,*addv);
350 }
351 
352 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesnnnn_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr )
353 {
354   matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr);
355 }
356 
357 PETSC_EXTERN void PETSC_STDCALL  matsetvalues0_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr )
358 {
359   matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr);
360 }
361 
362 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesnn1_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr )
363 {
364   matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr);
365 }
366 
367 PETSC_EXTERN void PETSC_STDCALL  matsetvalues11_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr )
368 {
369   matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr);
370 }
371 
372 PETSC_EXTERN void PETSC_STDCALL  matsetvaluesn1_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr )
373 {
374   matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr);
375 }
376 
377 PETSC_EXTERN void PETSC_STDCALL  matsetvalues1n_(Mat *mat,PetscInt *m, PetscInt idxm[],PetscInt *n, PetscInt idxn[], PetscScalar v[],InsertMode *addv, int *ierr )
378 {
379   matsetvalues_(mat,m,idxm,n,idxn,v,addv,ierr);
380 }
381 
382 PETSC_EXTERN void PETSC_STDCALL  matsetvalueslocal_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr )
383 {
384   *ierr = MatSetValuesLocal(*mat,*nrow,irow,*ncol,icol,y,*addv);
385 }
386 
387 PETSC_EXTERN void PETSC_STDCALL  matsetvalueslocal0_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr )
388 {
389   matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr);
390 }
391 
392 PETSC_EXTERN void PETSC_STDCALL  matsetvalueslocal11_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr )
393 {
394   matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr);
395 }
396 
397 PETSC_EXTERN void PETSC_STDCALL  matsetvalueslocal11nn_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr )
398 {
399   matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr);
400 }
401 
402 PETSC_EXTERN void PETSC_STDCALL  matsetvalueslocal111_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr )
403 {
404   matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr);
405 }
406 
407 PETSC_EXTERN void PETSC_STDCALL  matsetvalueslocal1n_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr )
408 {
409   matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr);
410 }
411 
412 PETSC_EXTERN void PETSC_STDCALL  matsetvalueslocaln1_(Mat *mat,PetscInt *nrow, PetscInt irow[],PetscInt *ncol, PetscInt icol[], PetscScalar y[],InsertMode *addv, int *ierr )
413 {
414   matsetvalueslocal_(mat,nrow,irow,ncol,icol,y,addv,ierr);
415 }
416 
417 PETSC_EXTERN void PETSC_STDCALL  matgetrowmin_(Mat *mat,Vec *v,PetscInt idx[], int *ierr )
418 {
419   CHKFORTRANNULLINTEGER(idx);
420   *ierr = MatGetRowMin(*mat,*v,idx);
421 }
422 
423 PETSC_EXTERN void PETSC_STDCALL  matgetrowminabs_(Mat *mat,Vec *v,PetscInt idx[], int *ierr )
424 {
425   CHKFORTRANNULLINTEGER(idx);
426   *ierr = MatGetRowMinAbs(*mat,*v,idx);
427 }
428 
429 PETSC_EXTERN void PETSC_STDCALL  matgetrowmax_(Mat *mat,Vec *v,PetscInt idx[], int *ierr )
430 {
431   CHKFORTRANNULLINTEGER(idx);
432   *ierr = MatGetRowMax(*mat,*v,idx);
433 }
434 
435 PETSC_EXTERN void PETSC_STDCALL  matgetrowmaxabs_(Mat *mat,Vec *v,PetscInt idx[], int *ierr )
436 {
437   CHKFORTRANNULLINTEGER(idx);
438   *ierr = MatGetRowMaxAbs(*mat,*v,idx);
439 }
440 
441 static PetscErrorCode ournullfunction(MatNullSpace sp,Vec x,void *ctx)
442 {
443   PetscErrorCode ierr = 0;
444   (*(void (PETSC_STDCALL *)(MatNullSpace*,Vec*,void*,PetscErrorCode*))(((PetscObject)sp)->fortran_func_pointers[0]))(&sp,&x,ctx,&ierr);CHKERRQ(ierr);
445   return 0;
446 }
447 
448 PETSC_EXTERN void PETSC_STDCALL matnullspacesetfunction_(MatNullSpace *sp, PetscErrorCode (*rem)(MatNullSpace,Vec,void*),void *ctx,PetscErrorCode *ierr)
449 {
450   PetscObjectAllocateFortranPointers(*sp,1);
451   ((PetscObject)*sp)->fortran_func_pointers[0] = (PetscVoidFunction)rem;
452 
453   *ierr = MatNullSpaceSetFunction(*sp,ournullfunction,ctx);
454 }
455 
456 PETSC_EXTERN void PETSC_STDCALL matcreatevecs_(Mat *mat,Vec *right,Vec *left, int *ierr)
457 {
458   CHKFORTRANNULLOBJECT(right);
459   CHKFORTRANNULLOBJECT(left);
460   *ierr = MatCreateVecs(*mat,right,left);
461 }
462 
463 PETSC_EXTERN void PETSC_STDCALL matgetrowij_(Mat *B,PetscInt *shift,PetscBool *sym,PetscBool *blockcompressed,PetscInt *n,PetscInt *ia,size_t *iia,
464                                 PetscInt *ja,size_t *jja,PetscBool  *done,PetscErrorCode *ierr)
465 {
466   const PetscInt *IA,*JA;
467   *ierr = MatGetRowIJ(*B,*shift,*sym,*blockcompressed,n,&IA,&JA,done);if (*ierr) return;
468   *iia  = PetscIntAddressToFortran(ia,(PetscInt*)IA);
469   *jja  = PetscIntAddressToFortran(ja,(PetscInt*)JA);
470 }
471 
472 PETSC_EXTERN void PETSC_STDCALL matrestorerowij_(Mat *B,PetscInt *shift,PetscBool *sym,PetscBool *blockcompressed, PetscInt *n,PetscInt *ia,size_t *iia,
473                                     PetscInt *ja,size_t *jja,PetscBool  *done,PetscErrorCode *ierr)
474 {
475   const PetscInt *IA = PetscIntAddressFromFortran(ia,*iia),*JA = PetscIntAddressFromFortran(ja,*jja);
476   *ierr = MatRestoreRowIJ(*B,*shift,*sym,*blockcompressed,n,&IA,&JA,done);
477 }
478 
479 /*
480    This is a poor way of storing the column and value pointers
481   generated by MatGetRow() to be returned with MatRestoreRow()
482   but there is not natural,good place else to store them. Hence
483   Fortran programmers can only have one outstanding MatGetRows()
484   at a time.
485 */
486 static PetscErrorCode    matgetrowactive = 0;
487 static const PetscInt    *my_ocols       = 0;
488 static const PetscScalar *my_ovals       = 0;
489 
490 PETSC_EXTERN void PETSC_STDCALL matgetrow_(Mat *mat,PetscInt *row,PetscInt *ncols,PetscInt *cols,PetscScalar *vals,PetscErrorCode *ierr)
491 {
492   const PetscInt    **oocols = &my_ocols;
493   const PetscScalar **oovals = &my_ovals;
494 
495   if (matgetrowactive) {
496     PetscError(PETSC_COMM_SELF,__LINE__,"MatGetRow_Fortran",__FILE__,PETSC_ERR_ARG_WRONGSTATE,PETSC_ERROR_INITIAL,
497                "Cannot have two MatGetRow() active simultaneously\n\
498                call MatRestoreRow() before calling MatGetRow() a second time");
499     *ierr = 1;
500     return;
501   }
502 
503   CHKFORTRANNULLINTEGER(cols); if (!cols) oocols = NULL;
504   CHKFORTRANNULLSCALAR(vals);  if (!vals) oovals = NULL;
505 
506   *ierr = MatGetRow(*mat,*row,ncols,oocols,oovals);
507   if (*ierr) return;
508 
509   if (oocols) { *ierr = PetscArraycpy(cols,my_ocols,*ncols); if (*ierr) return;}
510   if (oovals) { *ierr = PetscArraycpy(vals,my_ovals,*ncols); if (*ierr) return;}
511   matgetrowactive = 1;
512 }
513 
514 PETSC_EXTERN void PETSC_STDCALL matrestorerow_(Mat *mat,PetscInt *row,PetscInt *ncols,PetscInt *cols,PetscScalar *vals,PetscErrorCode *ierr)
515 {
516   const PetscInt    **oocols = &my_ocols;
517   const PetscScalar **oovals = &my_ovals;
518   if (!matgetrowactive) {
519     PetscError(PETSC_COMM_SELF,__LINE__,"MatRestoreRow_Fortran",__FILE__,PETSC_ERR_ARG_WRONGSTATE,PETSC_ERROR_INITIAL,
520                "Must call MatGetRow() first");
521     *ierr = 1;
522     return;
523   }
524   CHKFORTRANNULLINTEGER(cols); if (!cols) oocols = NULL;
525   CHKFORTRANNULLSCALAR(vals);  if (!vals) oovals = NULL;
526 
527   *ierr           = MatRestoreRow(*mat,*row,ncols,oocols,oovals);
528   matgetrowactive = 0;
529 }
530 
531 PETSC_EXTERN void PETSC_STDCALL matview_(Mat *mat,PetscViewer *vin,PetscErrorCode *ierr)
532 {
533   PetscViewer v;
534   PetscPatchDefaultViewers_Fortran(vin,v);
535   *ierr = MatView(*mat,v);
536 }
537 
538 PETSC_EXTERN void PETSC_STDCALL matload_(Mat *mat,PetscViewer *vin,PetscErrorCode *ierr)
539 {
540   PetscViewer v;
541   PetscPatchDefaultViewers_Fortran(vin,v);
542   *ierr = MatLoad(*mat,v);
543 }
544 
545 PETSC_EXTERN void PETSC_STDCALL matseqaijgetarray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
546 {
547   PetscScalar *mm;
548   PetscInt    m,n;
549 
550   *ierr = MatSeqAIJGetArray(*mat,&mm); if (*ierr) return;
551   *ierr = MatGetSize(*mat,&m,&n);  if (*ierr) return;
552   *ierr = PetscScalarAddressToFortran((PetscObject)*mat,1,fa,mm,m*n,ia); if (*ierr) return;
553 }
554 
555 PETSC_EXTERN void PETSC_STDCALL matseqaijrestorearray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
556 {
557   PetscScalar *lx;
558   PetscInt    m,n;
559 
560   *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return;
561   *ierr = PetscScalarAddressFromFortran((PetscObject)*mat,fa,*ia,m*n,&lx);if (*ierr) return;
562   *ierr = MatSeqAIJRestoreArray(*mat,&lx);if (*ierr) return;
563 }
564 
565 PETSC_EXTERN void PETSC_STDCALL matdensegetarray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
566 {
567   PetscScalar *mm;
568   PetscInt    m,n;
569 
570   *ierr = MatDenseGetArray(*mat,&mm); if (*ierr) return;
571   *ierr = MatGetSize(*mat,&m,&n);  if (*ierr) return;
572   *ierr = PetscScalarAddressToFortran((PetscObject)*mat,1,fa,mm,m*n,ia); if (*ierr) return;
573 }
574 
575 PETSC_EXTERN void PETSC_STDCALL matdenserestorearray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
576 {
577   PetscScalar *lx;
578   PetscInt    m,n;
579 
580   *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return;
581   *ierr = PetscScalarAddressFromFortran((PetscObject)*mat,fa,*ia,m*n,&lx);if (*ierr) return;
582   *ierr = MatDenseRestoreArray(*mat,&lx);if (*ierr) return;
583 }
584 
585 PETSC_EXTERN void PETSC_STDCALL matdensegetarrayread_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
586 {
587   const PetscScalar *mm;
588   PetscInt         m,n;
589 
590   *ierr = MatDenseGetArrayRead(*mat,&mm); if (*ierr) return;
591   *ierr = MatGetSize(*mat,&m,&n);  if (*ierr) return;
592   *ierr = PetscScalarAddressToFortran((PetscObject)*mat,1,fa,(PetscScalar*)mm,m*n,ia); if (*ierr) return;
593 }
594 
595 
596 PETSC_EXTERN void PETSC_STDCALL matdenserestorearrayread_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
597 {
598   const PetscScalar *lx;
599   PetscInt          m,n;
600 
601   *ierr = MatGetSize(*mat,&m,&n); if (*ierr) return;
602   *ierr = PetscScalarAddressFromFortran((PetscObject)*mat,fa,*ia,m*n,(PetscScalar**)&lx);if (*ierr) return;
603   *ierr = MatDenseRestoreArrayRead(*mat,&lx);if (*ierr) return;
604 }
605 
606 PETSC_EXTERN void PETSC_STDCALL matfactorgetsolverpackage_(Mat *mat,char* name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
607 {
608   const char *tname;
609 
610   *ierr = MatFactorGetSolverType(*mat,&tname);if (*ierr) return;
611   if (name != PETSC_NULL_CHARACTER_Fortran) {
612     *ierr = PetscStrncpy(name,tname,len);if (*ierr) return;
613   }
614   FIXRETURNCHAR(PETSC_TRUE,name,len);
615 }
616 
617 PETSC_EXTERN void PETSC_STDCALL matgetfactor_(Mat *mat,char* outtype PETSC_MIXED_LEN(len),MatFactorType *ftype,Mat *M,PetscErrorCode *ierr PETSC_END_LEN(len))
618 {
619   char *t;
620   FIXCHAR(outtype,len,t);
621   *ierr = MatGetFactor(*mat,t,*ftype,M);if (*ierr) return;
622   FREECHAR(outtype,t);
623 }
624 
625 PETSC_EXTERN void PETSC_STDCALL matconvert_(Mat *mat,char* outtype PETSC_MIXED_LEN(len),MatReuse *reuse,Mat *M,PetscErrorCode *ierr PETSC_END_LEN(len))
626 {
627   char *t;
628   FIXCHAR(outtype,len,t);
629   *ierr = MatConvert(*mat,t,*reuse,M);if (*ierr) return;
630   FREECHAR(outtype,t);
631 }
632 
633 /*
634     MatCreateSubmatrices() is slightly different from C since the
635     Fortran provides the array to hold the submatrix objects,while in C that
636     array is allocated by the MatCreateSubmatrices()
637 */
638 PETSC_EXTERN void PETSC_STDCALL matcreatesubmatrices_(Mat *mat,PetscInt *n,IS *isrow,IS *iscol,MatReuse *scall,Mat *smat,PetscErrorCode *ierr)
639 {
640   Mat      *lsmat;
641   PetscInt i;
642 
643   if (*scall == MAT_INITIAL_MATRIX) {
644     *ierr = MatCreateSubMatrices(*mat,*n,isrow,iscol,*scall,&lsmat);
645     for (i=0; i<=*n; i++) { /* lsmat[*n] might be a dummy matrix for saving data struc */
646       smat[i] = lsmat[i];
647     }
648     *ierr = PetscFree(lsmat);
649   } else {
650     *ierr = MatCreateSubMatrices(*mat,*n,isrow,iscol,*scall,&smat);
651   }
652 }
653 
654 /*
655     MatCreateSubmatrices() is slightly different from C since the
656     Fortran provides the array to hold the submatrix objects,while in C that
657     array is allocated by the MatCreateSubmatrices()
658 */
659 PETSC_EXTERN void PETSC_STDCALL matcreatesubmatricesmpi_(Mat *mat,PetscInt *n,IS *isrow,IS *iscol,MatReuse *scall,Mat *smat,PetscErrorCode *ierr)
660 {
661   Mat      *lsmat;
662   PetscInt i;
663 
664   if (*scall == MAT_INITIAL_MATRIX) {
665     *ierr = MatCreateSubMatricesMPI(*mat,*n,isrow,iscol,*scall,&lsmat);
666     for (i=0; i<=*n; i++) { /* lsmat[*n] might be a dummy matrix for saving data struc */
667       smat[i] = lsmat[i];
668     }
669     *ierr = PetscFree(lsmat);
670   } else {
671     *ierr = MatCreateSubMatricesMPI(*mat,*n,isrow,iscol,*scall,&smat);
672   }
673 }
674 
675 /*
676     MatDestroyMatrices() is slightly different from C since the
677     Fortran does not free the array of matrix objects, while in C that
678     the array is freed
679 */
680 PETSC_EXTERN void PETSC_STDCALL matdestroymatrices_(PetscInt *n,Mat *smat,PetscErrorCode *ierr)
681 {
682   PetscInt i;
683 
684   for (i=0; i<*n; i++) {
685     *ierr = MatDestroy(&smat[i]);if (*ierr) return;
686   }
687 }
688 
689 /*
690     MatDestroySubMatrices() is slightly different from C since the
691     Fortran provides the array to hold the submatrix objects, while in C that
692     array is allocated by the MatCreateSubmatrices()
693 */
694 PETSC_EXTERN void PETSC_STDCALL matdestroysubmatrices_(PetscInt *n,Mat *smat,PetscErrorCode *ierr)
695 {
696   Mat      *lsmat;
697   PetscInt i;
698 
699   *ierr = PetscMalloc1(*n+1,&lsmat);
700   for (i=0; i<=*n; i++) {
701       lsmat[i] = smat[i];
702   }
703   *ierr = MatDestroySubMatrices(*n,&lsmat);
704 }
705 
706 PETSC_EXTERN void PETSC_STDCALL matsetoptionsprefix_(Mat *mat,char* prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
707 {
708   char *t;
709 
710   FIXCHAR(prefix,len,t);
711   *ierr = MatSetOptionsPrefix(*mat,t);if (*ierr) return;
712   FREECHAR(prefix,t);
713 }
714 
715 PETSC_EXTERN void PETSC_STDCALL matnullspaceremove_(MatNullSpace *sp,Vec *vec,PetscErrorCode *ierr)
716 {
717   CHKFORTRANNULLOBJECT(*sp)
718   *ierr = MatNullSpaceRemove(*sp,*vec);
719 }
720 
721 PETSC_EXTERN void PETSC_STDCALL matgetinfo_(Mat *mat,MatInfoType *flag,MatInfo *info, int *ierr)
722 {
723   *ierr = MatGetInfo(*mat,*flag,info);
724 }
725 
726 PETSC_EXTERN void PETSC_STDCALL matlufactor_(Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr)
727 {
728   *ierr = MatLUFactor(*mat,*row,*col,info);
729 }
730 
731 PETSC_EXTERN void PETSC_STDCALL matilufactor_(Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr)
732 {
733   *ierr = MatILUFactor(*mat,*row,*col,info);
734 }
735 
736 PETSC_EXTERN void PETSC_STDCALL matlufactorsymbolic_(Mat *fact,Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr)
737 {
738   *ierr = MatLUFactorSymbolic(*fact,*mat,*row,*col,info);
739 }
740 
741 PETSC_EXTERN void PETSC_STDCALL matlufactornumeric_(Mat *fact,Mat *mat,const MatFactorInfo *info, int *ierr)
742 {
743   *ierr = MatLUFactorNumeric(*fact,*mat,info);
744 }
745 
746 PETSC_EXTERN void PETSC_STDCALL matcholeskyfactor_(Mat *mat,IS *perm,const MatFactorInfo *info, int *ierr)
747 {
748   *ierr = MatCholeskyFactor(*mat,*perm,info);
749 }
750 
751 PETSC_EXTERN void PETSC_STDCALL matcholeskyfactorsymbolic_(Mat *fact,Mat *mat,IS *perm,const MatFactorInfo *info, int *ierr)
752 {
753   *ierr = MatCholeskyFactorSymbolic(*fact,*mat,*perm,info);
754 }
755 
756 PETSC_EXTERN void PETSC_STDCALL matcholeskyfactornumeric_(Mat *fact,Mat *mat,const MatFactorInfo *info, int *ierr)
757 {
758   *ierr = MatCholeskyFactorNumeric(*fact,*mat,info);
759 }
760 
761 PETSC_EXTERN void PETSC_STDCALL matilufactorsymbolic_(Mat *fact,Mat *mat,IS *row,IS *col,const MatFactorInfo *info, int *ierr)
762 {
763   *ierr = MatILUFactorSymbolic(*fact,*mat,*row,*col,info);
764 }
765 
766 PETSC_EXTERN void PETSC_STDCALL maticcfactorsymbolic_(Mat *fact,Mat *mat,IS *perm,const MatFactorInfo *info, int *ierr)
767 {
768   *ierr = MatICCFactorSymbolic(*fact,*mat,*perm,info);
769 }
770 
771 PETSC_EXTERN void PETSC_STDCALL maticcfactor_(Mat *mat,IS *row,const MatFactorInfo *info, int *ierr)
772 {
773   *ierr = MatICCFactor(*mat,*row,info);
774 }
775 
776 PETSC_EXTERN void PETSC_STDCALL matfactorinfoinitialize_(MatFactorInfo *info, int *ierr)
777 {
778   *ierr = MatFactorInfoInitialize(info);
779 }
780 PETSC_EXTERN void PETSC_STDCALL  matzerorowslocal_(Mat *mat,PetscInt *numRows, PetscInt rows[],PetscScalar *diag,Vec *x,Vec *b, int *ierr)
781 {
782   *ierr = MatZeroRowsLocal(*mat,*numRows,rows,*diag,*x,*b);
783 }
784 PETSC_EXTERN void PETSC_STDCALL  matzerorowslocal0_(Mat *mat,PetscInt *numRows, PetscInt rows[],PetscScalar *diag,Vec *x,Vec *b, int *ierr)
785 {
786   matzerorowslocal_(mat,numRows,rows,diag,x,b,ierr);
787 }
788 PETSC_EXTERN void PETSC_STDCALL  matzerorowslocal1_(Mat *mat,PetscInt *numRows, PetscInt rows[],PetscScalar *diag,Vec *x,Vec *b, int *ierr)
789 {
790   matzerorowslocal_(mat,numRows,rows,diag,x,b,ierr);
791 }
792 PETSC_EXTERN void PETSC_STDCALL matviewfromoptions_(Mat *ao,PetscObject obj,char* type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
793 {
794   char *t;
795 
796   FIXCHAR(type,len,t);
797   *ierr = MatViewFromOptions(*ao,obj,t);if (*ierr) return;
798   FREECHAR(type,t);
799 }
800