CoCalc -- umf4_f77zwrapper.c

GitHub Repository: ElmerCSC/elmerfem
Path: blob/devel/umfpack/demo/umf4_f77zwrapper.c
³¹⁹⁶ views
1
/* ========================================================================== */
2
/* === umf4_f77zwrapper ===================================================== */
3
/* ========================================================================== */
4

5
/* -------------------------------------------------------------------------- */
6
/* UMFPACK Version 4.4, Copyright (c) 2005 by Timothy A. Davis.  CISE Dept,   */
7
/* Univ. of Florida.  All Rights Reserved.  See ../Doc/License for License.   */
8
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
9
/* -------------------------------------------------------------------------- */
10

11
/* FORTRAN interface for the C-callable UMFPACK library (complex / int version
12
 * only and complex / long versions only).  This is HIGHLY non-portable.  You
13
 * will need to modify this depending on how your FORTRAN and C compilers
14
 * 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 long */
36
/* -------------------------------------------------------------------------- */
37

38
#if defined (ZLONG)
39

40
#define Int 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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

464
Product

Resources

Company
