1 /* ========================================================================== */
2 /* === umf4_f77zwrapper ===================================================== */
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 (complex / int version
12  * only and complex / 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.
15  *
16  * See umf4z_f77wrapper.c for more information.
17  *
18  * The complex values are provided in two separate arrays.  Ax contains the
19  * real part and Az contains the imaginary part.  The solution vector is in
20  * x (the real part) and xz (the imaginary part.  b is the real part of the
21  * right-hand-side and bz is the imaginary part.  Does not support the
22  * packed complex type.
23  */
24 
25 #include "umfpack.h"
26 #include <ctype.h>
27 #include <stdio.h>
28 #ifdef NULL
29 #undef NULL
30 #endif
31 #define NULL 0
32 #define LEN 200
33 
34 /* -------------------------------------------------------------------------- */
35 /* integer type: int or SuiteSparse_long */
36 /* -------------------------------------------------------------------------- */
37 
38 #if defined (ZLONG)
39 
40 #define Int SuiteSparse_long
41 #define UMFPACK_defaults	 umfpack_zl_defaults
42 #define UMFPACK_free_numeric	 umfpack_zl_free_numeric
43 #define UMFPACK_free_symbolic	 umfpack_zl_free_symbolic
44 #define UMFPACK_numeric		 umfpack_zl_numeric
45 #define UMFPACK_report_control	 umfpack_zl_report_control
46 #define UMFPACK_report_info	 umfpack_zl_report_info
47 #define UMFPACK_save_numeric	 umfpack_zl_save_numeric
48 #define UMFPACK_save_symbolic	 umfpack_zl_save_symbolic
49 #define UMFPACK_load_numeric	 umfpack_zl_load_numeric
50 #define UMFPACK_load_symbolic	 umfpack_zl_load_symbolic
51 #define UMFPACK_scale		 umfpack_zl_scale
52 #define UMFPACK_solve		 umfpack_zl_solve
53 #define UMFPACK_symbolic	 umfpack_zl_symbolic
54 
55 #else
56 
57 #define Int int
58 #define UMFPACK_defaults	 umfpack_zi_defaults
59 #define UMFPACK_free_numeric	 umfpack_zi_free_numeric
60 #define UMFPACK_free_symbolic	 umfpack_zi_free_symbolic
61 #define UMFPACK_numeric		 umfpack_zi_numeric
62 #define UMFPACK_report_control	 umfpack_zi_report_control
63 #define UMFPACK_report_info	 umfpack_zi_report_info
64 #define UMFPACK_save_numeric	 umfpack_zi_save_numeric
65 #define UMFPACK_save_symbolic	 umfpack_zi_save_symbolic
66 #define UMFPACK_load_numeric	 umfpack_zi_load_numeric
67 #define UMFPACK_load_symbolic	 umfpack_zi_load_symbolic
68 #define UMFPACK_scale		 umfpack_zi_scale
69 #define UMFPACK_solve		 umfpack_zi_solve
70 #define UMFPACK_symbolic	 umfpack_zi_symbolic
71 
72 #endif
73 
74 /* -------------------------------------------------------------------------- */
75 /* construct a file name from a file number (not user-callable) */
76 /* -------------------------------------------------------------------------- */
77 
make_filename(Int filenum,char * prefix,char * filename)78 static void make_filename (Int filenum, char *prefix, char *filename)
79 {
80     char *psrc, *pdst ;
81 #ifdef ZLONG
82     sprintf (filename, "%s%ld.umf", prefix, filenum) ;
83 #else
84     sprintf (filename, "%s%d.umf", prefix, filenum) ;
85 #endif
86     /* remove any spaces in the filename */
87     pdst = filename ;
88     for (psrc = filename ; *psrc ; psrc++)
89     {
90 	if (!isspace (*psrc)) *pdst++ = *psrc ;
91     }
92     *pdst = '\0' ;
93 }
94 
95 /* ========================================================================== */
96 /* === with underscore ====================================================== */
97 /* ========================================================================== */
98 
99 /* Solaris, Linux, and SGI IRIX.  Probably Compaq Alpha as well. */
100 
101 /* -------------------------------------------------------------------------- */
102 /* umf4zdef: set default control parameters */
103 /* -------------------------------------------------------------------------- */
104 
105 /* call umf4zdef (control) */
106 
umf4zdef_(double Control[UMFPACK_CONTROL])107 void umf4zdef_ (double Control [UMFPACK_CONTROL])
108 {
109     UMFPACK_defaults (Control) ;
110 }
111 
112 /* -------------------------------------------------------------------------- */
113 /* umf4zpcon: print control parameters */
114 /* -------------------------------------------------------------------------- */
115 
116 /* call umf4zpcon (control) */
117 
umf4zpcon_(double Control[UMFPACK_CONTROL])118 void umf4zpcon_ (double Control [UMFPACK_CONTROL])
119 {
120     fflush (stdout) ;
121     UMFPACK_report_control (Control) ;
122     fflush (stdout) ;
123 }
124 
125 /* -------------------------------------------------------------------------- */
126 /* umf4zsym: pre-ordering and symbolic factorization */
127 /* -------------------------------------------------------------------------- */
128 
129 /* call umf4zsym (m, n, Ap, Ai, Ax, Az, symbolic, control, info) */
130 
umf4zsym_(Int * m,Int * n,Int Ap[],Int Ai[],double Ax[],double Az[],void ** Symbolic,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])131 void umf4zsym_ (Int *m, Int *n, Int Ap [ ], Int Ai [ ],
132     double Ax [ ], double Az [ ], void **Symbolic,
133     double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
134 {
135     (void) UMFPACK_symbolic (*m, *n, Ap, Ai, Ax, Az, Symbolic, Control, Info) ;
136 }
137 
138 /* -------------------------------------------------------------------------- */
139 /* umf4znum: numeric factorization */
140 /* -------------------------------------------------------------------------- */
141 
142 /* call umf4znum (Ap, Ai, Ax, Az, symbolic, numeric, control, info) */
143 
umf4znum_(Int Ap[],Int Ai[],double Ax[],double Az[],void ** Symbolic,void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])144 void umf4znum_ (Int Ap [ ], Int Ai [ ], double Ax [ ], double Az [ ],
145     void **Symbolic, void **Numeric,
146     double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
147 {
148     (void) UMFPACK_numeric (Ap, Ai, Ax, Az, *Symbolic, Numeric, Control, Info);
149 }
150 
151 /* -------------------------------------------------------------------------- */
152 /* umf4zsolr: solve a linear system with iterative refinement */
153 /* -------------------------------------------------------------------------- */
154 
155 /* call umf4zsolr (sys, Ap, Ai, Ax, Az, x, xz, b, bz, numeric, control, info) */
156 
umf4zsolr_(Int * sys,Int Ap[],Int Ai[],double Ax[],double Az[],double x[],double xz[],double b[],double bz[],void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])157 void umf4zsolr_ (Int *sys, Int Ap [ ], Int Ai [ ], double Ax [ ], double Az [ ],
158     double x [ ], double xz [ ], double b [ ], double bz [ ], void **Numeric,
159     double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
160 {
161     (void) UMFPACK_solve (*sys, Ap, Ai, Ax, Az, x, xz, b, bz,
162 	*Numeric, Control, Info) ;
163 }
164 
165 /* -------------------------------------------------------------------------- */
166 /* umf4zsol: solve a linear system without iterative refinement */
167 /* -------------------------------------------------------------------------- */
168 
169 /* call umf4zsol (sys, x, xz, b, bz, numeric, control, info) */
170 
umf4zsol_(Int * sys,double x[],double xz[],double b[],double bz[],void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])171 void umf4zsol_ (Int *sys, double x [ ], double xz [ ], double b [ ],
172     double bz [ ], void **Numeric,
173     double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
174 {
175     Control [UMFPACK_IRSTEP] = 0 ;
176     (void) UMFPACK_solve (*sys, (Int *) NULL, (Int *) NULL, (double *) NULL,
177 	(double *) NULL, x, xz, b, bz, *Numeric, Control, Info) ;
178 }
179 
180 /* -------------------------------------------------------------------------- */
181 /* umf4zscal: scale a vector using UMFPACK's scale factors */
182 /* -------------------------------------------------------------------------- */
183 
184 /* call umf4zscal (x, xz, b, bz, numeric, status) */
185 
umf4zscal_(double x[],double xz[],double b[],double bz[],void ** Numeric,Int * status)186 void umf4zscal_ (double x [ ], double xz [ ], double b [ ], double bz [ ],
187     void **Numeric, Int *status)
188 {
189     *status = UMFPACK_scale (x, xz, b, bz, *Numeric) ;
190 }
191 
192 /* -------------------------------------------------------------------------- */
193 /* umf4zpinf: print info */
194 /* -------------------------------------------------------------------------- */
195 
196 /* call umf4zpinf (control) */
197 
umf4zpinf_(double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])198 void umf4zpinf_ (double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
199 {
200     fflush (stdout) ;
201     UMFPACK_report_info (Control, Info) ;
202     fflush (stdout) ;
203 }
204 
205 /* -------------------------------------------------------------------------- */
206 /* umf4zfnum: free the Numeric object */
207 /* -------------------------------------------------------------------------- */
208 
209 /* call umf4zfnum (numeric) */
210 
umf4zfnum_(void ** Numeric)211 void umf4zfnum_ (void **Numeric)
212 {
213     UMFPACK_free_numeric (Numeric) ;
214 }
215 
216 /* -------------------------------------------------------------------------- */
217 /* umf4zfsym: free the Symbolic object */
218 /* -------------------------------------------------------------------------- */
219 
220 /* call umf4zfsym (symbolic) */
221 
umf4zfsym_(void ** Symbolic)222 void umf4zfsym_ (void **Symbolic)
223 {
224     UMFPACK_free_symbolic (Symbolic) ;
225 }
226 
227 /* -------------------------------------------------------------------------- */
228 /* umf4zsnum: save the Numeric object to a file */
229 /* -------------------------------------------------------------------------- */
230 
231 /* call umf4zsnum (numeric, filenum, status) */
232 
umf4zsnum_(void ** Numeric,Int * filenum,Int * status)233 void umf4zsnum_ (void **Numeric, Int *filenum, Int *status)
234 {
235     char filename [LEN] ;
236     make_filename (*filenum, "n", filename) ;
237     *status = UMFPACK_save_numeric (*Numeric, filename) ;
238 }
239 
240 /* -------------------------------------------------------------------------- */
241 /* umf4zssym: save the Symbolic object to a file */
242 /* -------------------------------------------------------------------------- */
243 
244 /* call umf4zssym (symbolic, filenum, status) */
245 
umf4zssym_(void ** Symbolic,Int * filenum,Int * status)246 void umf4zssym_ (void **Symbolic, Int *filenum, Int *status)
247 {
248     char filename [LEN] ;
249     make_filename (*filenum, "s", filename) ;
250     *status = UMFPACK_save_symbolic (*Symbolic, filename) ;
251 }
252 
253 /* -------------------------------------------------------------------------- */
254 /* umf4zlnum: load the Numeric object from a file */
255 /* -------------------------------------------------------------------------- */
256 
257 /* call umf4zlnum (numeric, filenum, status) */
258 
umf4zlnum_(void ** Numeric,Int * filenum,Int * status)259 void umf4zlnum_ (void **Numeric, Int *filenum, Int *status)
260 {
261     char filename [LEN] ;
262     make_filename (*filenum, "n", filename) ;
263     *status = UMFPACK_load_numeric (Numeric, filename) ;
264 }
265 
266 /* -------------------------------------------------------------------------- */
267 /* umf4zlsym: load the Symbolic object from a file */
268 /* -------------------------------------------------------------------------- */
269 
270 /* call umf4zlsym (symbolic, filenum, status) */
271 
umf4zlsym_(void ** Symbolic,Int * filenum,Int * status)272 void umf4zlsym_ (void **Symbolic, Int *filenum, Int *status)
273 {
274     char filename [LEN] ;
275     make_filename (*filenum, "s", filename) ;
276     *status = UMFPACK_load_symbolic (Symbolic, filename) ;
277 }
278 
279 /* ========================================================================== */
280 /* === with no underscore =================================================== */
281 /* ========================================================================== */
282 
283 /* IBM AIX.  Probably Microsoft Windows and HP Unix as well.  */
284 
285 /* -------------------------------------------------------------------------- */
286 /* umf4zdef: set default control parameters */
287 /* -------------------------------------------------------------------------- */
288 
289 /* call umf4zdef (control) */
290 
umf4zdef(double Control[UMFPACK_CONTROL])291 void umf4zdef (double Control [UMFPACK_CONTROL])
292 {
293     UMFPACK_defaults (Control) ;
294 }
295 
296 /* -------------------------------------------------------------------------- */
297 /* umf4zpcon: print control parameters */
298 /* -------------------------------------------------------------------------- */
299 
300 /* call umf4zpcon (control) */
301 
umf4zpcon(double Control[UMFPACK_CONTROL])302 void umf4zpcon (double Control [UMFPACK_CONTROL])
303 {
304     fflush (stdout) ;
305     UMFPACK_report_control (Control) ;
306     fflush (stdout) ;
307 }
308 
309 /* -------------------------------------------------------------------------- */
310 /* umf4zsym: pre-ordering and symbolic factorization */
311 /* -------------------------------------------------------------------------- */
312 
313 /* call umf4zsym (m, n, Ap, Ai, Ax, Az, symbolic, control, info) */
314 
umf4zsym(Int * m,Int * n,Int Ap[],Int Ai[],double Ax[],double Az[],void ** Symbolic,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])315 void umf4zsym (Int *m, Int *n, Int Ap [ ], Int Ai [ ],
316     double Ax [ ], double Az [ ], void **Symbolic,
317     double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
318 {
319     (void) UMFPACK_symbolic (*m, *n, Ap, Ai, Ax, Az, Symbolic, Control, Info) ;
320 }
321 
322 /* -------------------------------------------------------------------------- */
323 /* umf4znum: numeric factorization */
324 /* -------------------------------------------------------------------------- */
325 
326 /* call umf4znum (Ap, Ai, Ax, Az, symbolic, numeric, control, info) */
327 
umf4znum(Int Ap[],Int Ai[],double Ax[],double Az[],void ** Symbolic,void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])328 void umf4znum (Int Ap [ ], Int Ai [ ], double Ax [ ], double Az [ ],
329     void **Symbolic, void **Numeric,
330     double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
331 {
332     (void) UMFPACK_numeric (Ap, Ai, Ax, Az, *Symbolic, Numeric, Control, Info);
333 }
334 
335 /* -------------------------------------------------------------------------- */
336 /* umf4zsolr: solve a linear system with iterative refinement */
337 /* -------------------------------------------------------------------------- */
338 
339 /* call umf4zsolr (sys, Ap, Ai, Ax, Az, x, xz, b, bz, numeric, control, info) */
340 
umf4zsolr(Int * sys,Int Ap[],Int Ai[],double Ax[],double Az[],double x[],double xz[],double b[],double bz[],void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])341 void umf4zsolr (Int *sys, Int Ap [ ], Int Ai [ ], double Ax [ ], double Az [ ],
342     double x [ ], double xz [ ], double b [ ], double bz [ ], void **Numeric,
343     double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
344 {
345     (void) UMFPACK_solve (*sys, Ap, Ai, Ax, Az, x, xz, b, bz,
346 	*Numeric, Control, Info) ;
347 }
348 
349 /* -------------------------------------------------------------------------- */
350 /* umf4zsol: solve a linear system without iterative refinement */
351 /* -------------------------------------------------------------------------- */
352 
353 /* call umf4zsol (sys, x, xz, b, bz, numeric, control, info) */
354 
umf4zsol(Int * sys,double x[],double xz[],double b[],double bz[],void ** Numeric,double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])355 void umf4zsol (Int *sys, double x [ ], double xz [ ], double b [ ],
356     double bz [ ], void **Numeric,
357     double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
358 {
359     Control [UMFPACK_IRSTEP] = 0 ;
360     (void) UMFPACK_solve (*sys, (Int *) NULL, (Int *) NULL, (double *) NULL,
361 	(double *) NULL, x, xz, b, bz, *Numeric, Control, Info) ;
362 }
363 
364 /* -------------------------------------------------------------------------- */
365 /* umf4zscal: scale a vector using UMFPACK's scale factors */
366 /* -------------------------------------------------------------------------- */
367 
368 /* call umf4zscal (x, xz, b, bz, numeric, status) */
369 
umf4zscal(double x[],double xz[],double b[],double bz[],void ** Numeric,Int * status)370 void umf4zscal (double x [ ], double xz [ ], double b [ ], double bz [ ],
371     void **Numeric, Int *status)
372 {
373     *status = UMFPACK_scale (x, xz, b, bz, *Numeric) ;
374 }
375 
376 /* -------------------------------------------------------------------------- */
377 /* umf4zpinf: print info */
378 /* -------------------------------------------------------------------------- */
379 
380 /* call umf4zpinf (control) */
381 
umf4zpinf(double Control[UMFPACK_CONTROL],double Info[UMFPACK_INFO])382 void umf4zpinf (double Control [UMFPACK_CONTROL], double Info [UMFPACK_INFO])
383 {
384     fflush (stdout) ;
385     UMFPACK_report_info (Control, Info) ;
386     fflush (stdout) ;
387 }
388 
389 /* -------------------------------------------------------------------------- */
390 /* umf4zfnum: free the Numeric object */
391 /* -------------------------------------------------------------------------- */
392 
393 /* call umf4zfnum (numeric) */
394 
umf4zfnum(void ** Numeric)395 void umf4zfnum (void **Numeric)
396 {
397     UMFPACK_free_numeric (Numeric) ;
398 }
399 
400 /* -------------------------------------------------------------------------- */
401 /* umf4zfsym: free the Symbolic object */
402 /* -------------------------------------------------------------------------- */
403 
404 /* call umf4zfsym (symbolic) */
405 
umf4zfsym(void ** Symbolic)406 void umf4zfsym (void **Symbolic)
407 {
408     UMFPACK_free_symbolic (Symbolic) ;
409 }
410 
411 /* -------------------------------------------------------------------------- */
412 /* umf4zsnum: save the Numeric object to a file */
413 /* -------------------------------------------------------------------------- */
414 
415 /* call umf4zsnum (numeric, filenum, status) */
416 
umf4zsnum(void ** Numeric,Int * filenum,Int * status)417 void umf4zsnum (void **Numeric, Int *filenum, Int *status)
418 {
419     char filename [LEN] ;
420     make_filename (*filenum, "n", filename) ;
421     *status = UMFPACK_save_numeric (*Numeric, filename) ;
422 }
423 
424 /* -------------------------------------------------------------------------- */
425 /* umf4zssym: save the Symbolic object to a file */
426 /* -------------------------------------------------------------------------- */
427 
428 /* call umf4zssym (symbolic, filenum, status) */
429 
umf4zssym(void ** Symbolic,Int * filenum,Int * status)430 void umf4zssym (void **Symbolic, Int *filenum, Int *status)
431 {
432     char filename [LEN] ;
433     make_filename (*filenum, "s", filename) ;
434     *status = UMFPACK_save_symbolic (*Symbolic, filename) ;
435 }
436 
437 /* -------------------------------------------------------------------------- */
438 /* umf4zlnum: load the Numeric object from a file */
439 /* -------------------------------------------------------------------------- */
440 
441 /* call umf4zlnum (numeric, filenum, status) */
442 
umf4zlnum(void ** Numeric,Int * filenum,Int * status)443 void umf4zlnum (void **Numeric, Int *filenum, Int *status)
444 {
445     char filename [LEN] ;
446     make_filename (*filenum, "n", filename) ;
447     *status = UMFPACK_load_numeric (Numeric, filename) ;
448 }
449 
450 /* -------------------------------------------------------------------------- */
451 /* umf4zlsym: load the Symbolic object from a file */
452 /* -------------------------------------------------------------------------- */
453 
454 /* call umf4zlsym (symbolic, filenum, status) */
455 
umf4zlsym(void ** Symbolic,Int * filenum,Int * status)456 void umf4zlsym (void **Symbolic, Int *filenum, Int *status)
457 {
458     char filename [LEN] ;
459     make_filename (*filenum, "s", filename) ;
460     *status = UMFPACK_load_symbolic (Symbolic, filename) ;
461 }
462 
463