1 /* ========================================================================== */
2 /* === umf4_f77wrapper ====================================================== */
3 /* ========================================================================== */
4
5 /* -------------------------------------------------------------------------- */
6 /* UMFPACK Copyright (c) 2005-2012 by Timothy A. Davis, */
7 /* http://www.suitesparse.com. All Rights Reserved. */
8 /* See ../Doc/License.txt for License. */
9 /* -------------------------------------------------------------------------- */
10
11 /* FORTRAN interface for the C-callable UMFPACK library (double / int version
12 * only and double / SuiteSparse_long versions only). This is HIGHLY
13 * non-portable. You will need to modify this depending on how your FORTRAN
14 * and C compilers behave. This has been tested in Linux, Sun Solaris, SGI
15 * IRIX, and IBM AIX, with various compilers. It has not been exhaustively
16 * tested on all possible combinations of C and FORTRAN compilers. The
17 * SuiteSparse_long version works on Solaris, SGI IRIX, and IBM AIX when the
18 * UMFPACK library is compiled in 64-bit mode.
19 *
20 * Only a subset of UMFPACK's capabilities are provided. Refer to the UMFPACK
21 * User Guide for details.
22 *
23 * For some C and FORTRAN compilers, the FORTRAN compiler appends a single
24 * underscore ("_") after each routine name. C doesn't do this, so the
25 * translation is made here. Other FORTRAN compilers treat underscores
26 * differently. For example, a FORTRAN call to a_b gets translated to a call
27 * to a_b__ by g77, and to a_b_ by most other FORTRAN compilers. Thus, the
28 * FORTRAN names here do not use underscores. The xlf compiler in IBM AIX
29 * doesn't add an underscore.
30 *
31 * The matrix A is passed to UMFPACK in compressed column form, with 0-based
32 * indices. In FORTRAN, for an m-by-n matrix A with nz entries, the row
33 * indices of the first column (column 1) are in Ai (Ap (1) + 1 ... Ap (2)),
34 * with values in Ax (Ap (1) + 1 ... Ap (2)). The last column (column n) is
35 * in Ai (Ap (n) + 1 ... Ap (n+1)) and Ax (Ap (n) + 1 ... Ap (n+1)). The row
36 * indices in Ai are in the range 0 to m-1. They must be sorted, with no
37 * duplicate entries allowed. Refer to umfpack_di_triplet_to_col for a more
38 * flexible format for the input matrix. The following defintions apply
39 * for each of the routines in this file:
40 *
41 * integer m, n, Ap (n+1), Ai (nz), symbolic, numeric, filenum, status
42 * double precision Ax (nz), control (20), info (90), x (n), b (n)
43 *
44 * UMFPACK's status is returned in either a status argument, or in info (1).
45 * It is zero if everything is OK, 1 if the matrix is singular (this is a
46 * warning, not an error), and negative if an error occurred. See umfpack.h
47 * for more details on the contents of the control and info arrays, and the
48 * value of the sys argument.
49 *
50 * For the Numeric and Symbolic handles, it's probably safe to assume that a
51 * FORTRAN integer is sufficient to store a C pointer. If that doesn't work,
52 * try defining numeric and symbolic as integer arrays of size 2, or as
53 * integer*8, in the FORTRAN routine that calls these wrapper routines.
54 * The latter is required on Solaris, SGI IRIX, and IBM AIX when UMFPACK is
55 * compiled in 64-bit mode.
56 *
57 * If you want to use 64-bit integers, try compiling this file with the -DDLONG
58 * compiler option (via "make fortran64"). First modify your
59 * SuiteSparse_config.mk
60 * file to compile UMFPACK in LP64 mode (see the User Guide for details).
61 * Your FORTRAN code should use integer*8. See umf4hb64.f for an example.
62 */
63
64 #include "umfpack.h"
65 #include <ctype.h>
66 #include <stdio.h>
67 #ifdef NULL
68 #undef NULL
69 #endif
70 #define NULL 0
71 #define LEN 200
72
73 /* -------------------------------------------------------------------------- */
74 /* integer type: int or SuiteSparse_long */
75 /* -------------------------------------------------------------------------- */
76
77 #if defined (DLONG)
78
79 #define Int SuiteSparse_long
80 #define UMFPACK_defaults umfpack_dl_defaults
81 #define UMFPACK_free_numeric umfpack_dl_free_numeric
82 #define UMFPACK_free_symbolic umfpack_dl_free_symbolic
83 #define UMFPACK_numeric umfpack_dl_numeric
84 #define UMFPACK_report_control umfpack_dl_report_control
85 #define UMFPACK_report_info umfpack_dl_report_info
86 #define UMFPACK_save_numeric umfpack_dl_save_numeric
87 #define UMFPACK_save_symbolic umfpack_dl_save_symbolic
88 #define UMFPACK_load_numeric umfpack_dl_load_numeric
89 #define UMFPACK_load_symbolic umfpack_dl_load_symbolic
90 #define UMFPACK_scale umfpack_dl_scale
91 #define UMFPACK_solve umfpack_dl_solve
92 #define UMFPACK_symbolic umfpack_dl_symbolic
93
94 #else
95
96 #define Int int
97 #define UMFPACK_defaults umfpack_di_defaults
98 #define UMFPACK_free_numeric umfpack_di_free_numeric
99 #define UMFPACK_free_symbolic umfpack_di_free_symbolic
100 #define UMFPACK_numeric umfpack_di_numeric
101 #define UMFPACK_report_control umfpack_di_report_control
102 #define UMFPACK_report_info umfpack_di_report_info
103 #define UMFPACK_save_numeric umfpack_di_save_numeric
104 #define UMFPACK_save_symbolic umfpack_di_save_symbolic
105 #define UMFPACK_load_numeric umfpack_di_load_numeric
106 #define UMFPACK_load_symbolic umfpack_di_load_symbolic
107 #define UMFPACK_scale umfpack_di_scale
108 #define UMFPACK_solve umfpack_di_solve
109 #define UMFPACK_symbolic umfpack_di_symbolic
110
111 #endif
112
113 /* -------------------------------------------------------------------------- */
114 /* construct a file name from a file number (not user-callable) */
115 /* -------------------------------------------------------------------------- */
116
make_filename(Int filenum,char * prefix,char * filename)117 static void make_filename (Int filenum, char *prefix, char *filename)
118 {
119 char *psrc, *pdst ;
120 #ifdef DLONG
121 sprintf (filename, "%s%ld.umf", prefix, filenum) ;
122 #else
123 sprintf (filename, "%s%d.umf", prefix, filenum) ;
124 #endif
125 /* remove any spaces in the filename */
126 pdst = filename ;
127 for (psrc = filename ; *psrc ; psrc++)
128 {
129 if (!isspace (*psrc)) *pdst++ = *psrc ;
130 }
131 *pdst = '\0' ;
132 }
133
134 /* ========================================================================== */
135 /* === with underscore ====================================================== */
136 /* ========================================================================== */
137
138 /* Solaris, Linux, and SGI IRIX. Probably Compaq Alpha as well. */
139
140 /* -------------------------------------------------------------------------- */
141 /* umf4def: set default control parameters */
142 /* -------------------------------------------------------------------------- */
143
144 /* call umf4def (control) */
145
umf4def_(double Control[UMFPACK_CONTROL])146 void umf4def_ (double Control [UMFPACK_CONTROL])
147 {
148 UMFPACK_defaults (Control) ;
149 }
150
151 /* -------------------------------------------------------------------------- */
152 /* umf4pcon: print control parameters */
153 /* -------------------------------------------------------------------------- */
154
155 /* call umf4pcon (control) */
156
umf4pcon_(double Control[UMFPACK_CONTROL])157 void umf4pcon_ (double Control [UMFPACK_CONTROL])
158 {
159 fflush (stdout) ;
160 UMFPACK_report_control (Control) ;
161 fflush (stdout) ;
162 }
163
164 /* -------------------------------------------------------------------------- */
165 /* umf4sym: pre-ordering and symbolic factorization */
166 /* -------------------------------------------------------------------------- */
167
168 /* call umf4sym (m, n, Ap, Ai, Ax, symbolic, control, info) */
169
umf4sym_(Int * m,Int * n,Int Ap[],Int Ai[],double Ax[],void ** Symbolic,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])170 void umf4sym_ (Int *m, Int *n, Int Ap [ ], Int Ai [ ],
171 double Ax [ ], void **Symbolic,
172 double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
173 {
174 (void) UMFPACK_symbolic (*m, *n, Ap, Ai, Ax, Symbolic, Control, Info) ;
175 }
176
177 /* -------------------------------------------------------------------------- */
178 /* umf4num: numeric factorization */
179 /* -------------------------------------------------------------------------- */
180
181 /* call umf4num (Ap, Ai, Ax, symbolic, numeric, control, info) */
182
umf4num_(Int Ap[],Int Ai[],double Ax[],void ** Symbolic,void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])183 void umf4num_ (Int Ap [ ], Int Ai [ ], double Ax [ ],
184 void **Symbolic, void **Numeric,
185 double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
186 {
187 (void) UMFPACK_numeric (Ap, Ai, Ax, *Symbolic, Numeric, Control, Info);
188 }
189
190 /* -------------------------------------------------------------------------- */
191 /* umf4solr: solve a linear system with iterative refinement */
192 /* -------------------------------------------------------------------------- */
193
194 /* call umf4solr (sys, Ap, Ai, Ax, x, b, numeric, control, info) */
195
umf4solr_(Int * sys,Int Ap[],Int Ai[],double Ax[],double x[],double b[],void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])196 void umf4solr_ (Int *sys, Int Ap [ ], Int Ai [ ], double Ax [ ],
197 double x [ ], double b [ ], void **Numeric,
198 double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
199 {
200 (void) UMFPACK_solve (*sys, Ap, Ai, Ax, x, b, *Numeric, Control, Info) ;
201 }
202
203 /* -------------------------------------------------------------------------- */
204 /* umf4sol: solve a linear system without iterative refinement */
205 /* -------------------------------------------------------------------------- */
206
207 /* call umf4sol (sys, x, b, numeric, control, info) */
208
umf4sol_(Int * sys,double x[],double b[],void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])209 void umf4sol_ (Int *sys, double x [ ], double b [ ], void **Numeric,
210 double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
211 {
212 Control [UMFPACK_IRSTEP] = 0 ;
213 (void) UMFPACK_solve (*sys, (Int *) NULL, (Int *) NULL, (double *) NULL,
214 x, b, *Numeric, Control, Info) ;
215 }
216
217 /* -------------------------------------------------------------------------- */
218 /* umf4scal: scale a vector using UMFPACK's scale factors */
219 /* -------------------------------------------------------------------------- */
220
221 /* call umf4scal (x, b, numeric, status) */
222
umf4scal_(double x[],double b[],void ** Numeric,Int * status)223 void umf4scal_ (double x [ ], double b [ ], void **Numeric, Int *status)
224 {
225 *status = UMFPACK_scale (x, b, *Numeric) ;
226 }
227
228 /* -------------------------------------------------------------------------- */
229 /* umf4pinf: print info */
230 /* -------------------------------------------------------------------------- */
231
232 /* call umf4pinf (control) */
233
umf4pinf_(double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])234 void umf4pinf_ (double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
235 {
236 fflush (stdout) ;
237 UMFPACK_report_info (Control, Info) ;
238 fflush (stdout) ;
239 }
240
241 /* -------------------------------------------------------------------------- */
242 /* umf4fnum: free the Numeric object */
243 /* -------------------------------------------------------------------------- */
244
245 /* call umf4fnum (numeric) */
246
umf4fnum_(void ** Numeric)247 void umf4fnum_ (void **Numeric)
248 {
249 UMFPACK_free_numeric (Numeric) ;
250 }
251
252 /* -------------------------------------------------------------------------- */
253 /* umf4fsym: free the Symbolic object */
254 /* -------------------------------------------------------------------------- */
255
256 /* call umf4fsym (symbolic) */
257
umf4fsym_(void ** Symbolic)258 void umf4fsym_ (void **Symbolic)
259 {
260 UMFPACK_free_symbolic (Symbolic) ;
261 }
262
263 /* -------------------------------------------------------------------------- */
264 /* umf4snum: save the Numeric object to a file */
265 /* -------------------------------------------------------------------------- */
266
267 /* call umf4snum (numeric, filenum, status) */
268
umf4snum_(void ** Numeric,Int * filenum,Int * status)269 void umf4snum_ (void **Numeric, Int *filenum, Int *status)
270 {
271 char filename [LEN] ;
272 make_filename (*filenum, "n", filename) ;
273 *status = UMFPACK_save_numeric (*Numeric, filename) ;
274 }
275
276 /* -------------------------------------------------------------------------- */
277 /* umf4ssym: save the Symbolic object to a file */
278 /* -------------------------------------------------------------------------- */
279
280 /* call umf4ssym (symbolic, filenum, status) */
281
umf4ssym_(void ** Symbolic,Int * filenum,Int * status)282 void umf4ssym_ (void **Symbolic, Int *filenum, Int *status)
283 {
284 char filename [LEN] ;
285 make_filename (*filenum, "s", filename) ;
286 *status = UMFPACK_save_symbolic (*Symbolic, filename) ;
287 }
288
289 /* -------------------------------------------------------------------------- */
290 /* umf4lnum: load the Numeric object from a file */
291 /* -------------------------------------------------------------------------- */
292
293 /* call umf4lnum (numeric, filenum, status) */
294
umf4lnum_(void ** Numeric,Int * filenum,Int * status)295 void umf4lnum_ (void **Numeric, Int *filenum, Int *status)
296 {
297 char filename [LEN] ;
298 make_filename (*filenum, "n", filename) ;
299 *status = UMFPACK_load_numeric (Numeric, filename) ;
300 }
301
302 /* -------------------------------------------------------------------------- */
303 /* umf4lsym: load the Symbolic object from a file */
304 /* -------------------------------------------------------------------------- */
305
306 /* call umf4lsym (symbolic, filenum, status) */
307
umf4lsym_(void ** Symbolic,Int * filenum,Int * status)308 void umf4lsym_ (void **Symbolic, Int *filenum, Int *status)
309 {
310 char filename [LEN] ;
311 make_filename (*filenum, "s", filename) ;
312 *status = UMFPACK_load_symbolic (Symbolic, filename) ;
313 }
314
315 /* ========================================================================== */
316 /* === with no underscore =================================================== */
317 /* ========================================================================== */
318
319 /* IBM AIX. Probably Microsoft Windows and HP Unix as well. */
320
321 /* -------------------------------------------------------------------------- */
322 /* umf4def: set default control parameters */
323 /* -------------------------------------------------------------------------- */
324
325 /* call umf4def (control) */
326
umf4def(double Control[UMFPACK_CONTROL])327 void umf4def (double Control [UMFPACK_CONTROL])
328 {
329 UMFPACK_defaults (Control) ;
330 }
331
332 /* -------------------------------------------------------------------------- */
333 /* umf4pcon: print control parameters */
334 /* -------------------------------------------------------------------------- */
335
336 /* call umf4pcon (control) */
337
umf4pcon(double Control[UMFPACK_CONTROL])338 void umf4pcon (double Control [UMFPACK_CONTROL])
339 {
340 fflush (stdout) ;
341 UMFPACK_report_control (Control) ;
342 fflush (stdout) ;
343 }
344
345 /* -------------------------------------------------------------------------- */
346 /* umf4sym: pre-ordering and symbolic factorization */
347 /* -------------------------------------------------------------------------- */
348
349 /* call umf4sym (m, n, Ap, Ai, Ax, symbolic, control, info) */
350
umf4sym(Int * m,Int * n,Int Ap[],Int Ai[],double Ax[],void ** Symbolic,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])351 void umf4sym (Int *m, Int *n, Int Ap [ ], Int Ai [ ],
352 double Ax [ ], void **Symbolic,
353 double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
354 {
355 (void) UMFPACK_symbolic (*m, *n, Ap, Ai, Ax, Symbolic, Control, Info) ;
356 }
357
358 /* -------------------------------------------------------------------------- */
359 /* umf4num: numeric factorization */
360 /* -------------------------------------------------------------------------- */
361
362 /* call umf4num (Ap, Ai, Ax, symbolic, numeric, control, info) */
363
umf4num(Int Ap[],Int Ai[],double Ax[],void ** Symbolic,void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])364 void umf4num (Int Ap [ ], Int Ai [ ], double Ax [ ],
365 void **Symbolic, void **Numeric,
366 double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
367 {
368 (void) UMFPACK_numeric (Ap, Ai, Ax, *Symbolic, Numeric, Control, Info);
369 }
370
371 /* -------------------------------------------------------------------------- */
372 /* umf4solr: solve a linear system with iterative refinement */
373 /* -------------------------------------------------------------------------- */
374
375 /* call umf4solr (sys, Ap, Ai, Ax, x, b, numeric, control, info) */
376
umf4solr(Int * sys,Int Ap[],Int Ai[],double Ax[],double x[],double b[],void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])377 void umf4solr (Int *sys, Int Ap [ ], Int Ai [ ], double Ax [ ],
378 double x [ ], double b [ ], void **Numeric,
379 double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
380 {
381 (void) UMFPACK_solve (*sys, Ap, Ai, Ax, x, b, *Numeric, Control, Info) ;
382 }
383
384 /* -------------------------------------------------------------------------- */
385 /* umf4sol: solve a linear system without iterative refinement */
386 /* -------------------------------------------------------------------------- */
387
388 /* call umf4sol (sys, x, b, numeric, control, info) */
389
umf4sol(Int * sys,double x[],double b[],void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])390 void umf4sol (Int *sys, double x [ ], double b [ ], void **Numeric,
391 double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
392 {
393 Control [UMFPACK_IRSTEP] = 0 ;
394 (void) UMFPACK_solve (*sys, (Int *) NULL, (Int *) NULL, (double *) NULL,
395 x, b, *Numeric, Control, Info) ;
396 }
397
398 /* -------------------------------------------------------------------------- */
399 /* umf4scal: scale a vector using UMFPACK's scale factors */
400 /* -------------------------------------------------------------------------- */
401
402 /* call umf4scal (x, b, numeric, status) */
403
umf4scal(double x[],double b[],void ** Numeric,Int * status)404 void umf4scal (double x [ ], double b [ ], void **Numeric, Int *status)
405 {
406 *status = UMFPACK_scale (x, b, *Numeric) ;
407 }
408
409 /* -------------------------------------------------------------------------- */
410 /* umf4pinf: print info */
411 /* -------------------------------------------------------------------------- */
412
413 /* call umf4pinf (control) */
414
umf4pinf(double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])415 void umf4pinf (double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
416 {
417 fflush (stdout) ;
418 UMFPACK_report_info (Control, Info) ;
419 fflush (stdout) ;
420 }
421
422 /* -------------------------------------------------------------------------- */
423 /* umf4fnum: free the Numeric object */
424 /* -------------------------------------------------------------------------- */
425
426 /* call umf4fnum (numeric) */
427
umf4fnum(void ** Numeric)428 void umf4fnum (void **Numeric)
429 {
430 UMFPACK_free_numeric (Numeric) ;
431 }
432
433 /* -------------------------------------------------------------------------- */
434 /* umf4fsym: free the Symbolic object */
435 /* -------------------------------------------------------------------------- */
436
437 /* call umf4fsym (symbolic) */
438
umf4fsym(void ** Symbolic)439 void umf4fsym (void **Symbolic)
440 {
441 UMFPACK_free_symbolic (Symbolic) ;
442 }
443
444 /* -------------------------------------------------------------------------- */
445 /* umf4snum: save the Numeric object to a file */
446 /* -------------------------------------------------------------------------- */
447
448 /* call umf4snum (numeric, filenum, status) */
449
umf4snum(void ** Numeric,Int * filenum,Int * status)450 void umf4snum (void **Numeric, Int *filenum, Int *status)
451 {
452 char filename [LEN] ;
453 make_filename (*filenum, "n", filename) ;
454 *status = UMFPACK_save_numeric (*Numeric, filename) ;
455 }
456
457 /* -------------------------------------------------------------------------- */
458 /* umf4ssym: save the Symbolic object to a file */
459 /* -------------------------------------------------------------------------- */
460
461 /* call umf4ssym (symbolic, filenum, status) */
462
umf4ssym(void ** Symbolic,Int * filenum,Int * status)463 void umf4ssym (void **Symbolic, Int *filenum, Int *status)
464 {
465 char filename [LEN] ;
466 make_filename (*filenum, "s", filename) ;
467 *status = UMFPACK_save_symbolic (*Symbolic, filename) ;
468 }
469
470 /* -------------------------------------------------------------------------- */
471 /* umf4lnum: load the Numeric object from a file */
472 /* -------------------------------------------------------------------------- */
473
474 /* call umf4lnum (numeric, filenum, status) */
475
umf4lnum(void ** Numeric,Int * filenum,Int * status)476 void umf4lnum (void **Numeric, Int *filenum, Int *status)
477 {
478 char filename [LEN] ;
479 make_filename (*filenum, "n", filename) ;
480 *status = UMFPACK_load_numeric (Numeric, filename) ;
481 }
482
483 /* -------------------------------------------------------------------------- */
484 /* umf4lsym: load the Symbolic object from a file */
485 /* -------------------------------------------------------------------------- */
486
487 /* call umf4lsym (symbolic, filenum, status) */
488
umf4lsym(void ** Symbolic,Int * filenum,Int * status)489 void umf4lsym (void **Symbolic, Int *filenum, Int *status)
490 {
491 char filename [LEN] ;
492 make_filename (*filenum, "s", filename) ;
493 *status = UMFPACK_load_symbolic (Symbolic, filename) ;
494 }
495