OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
mumps_c.c
Go to the documentation of this file.
1/*
2 *
3 * This file is part of MUMPS 5.5.1, released
4 * on Tue Jul 12 13:17:24 UTC 2022
5 *
6 *
7 * Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
8 * Mumps Technologies, University of Bordeaux.
9 *
10 * This version of MUMPS is provided to you free of charge. It is
11 * released under the CeCILL-C license
12 * (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
13 * https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
14 *
15 */
16/* Header used for debug purpose only
17#include <stdio.h>
18*/
19#include <string.h>
20#include "mumps_common.h"
21#if MUMPS_ARITH == MUMPS_ARITH_s
22# include "smumps_c.h"
23# define MUMPS_REAL SMUMPS_REAL
24# define MUMPS_COMPLEX SMUMPS_COMPLEX
25#elif MUMPS_ARITH == MUMPS_ARITH_d
26# include "dmumps_c.h"
27# define MUMPS_REAL DMUMPS_REAL
28# define MUMPS_COMPLEX DMUMPS_COMPLEX
29#elif MUMPS_ARITH == MUMPS_ARITH_c
30# include "cmumps_c.h"
31# define MUMPS_REAL CMUMPS_REAL
32# define MUMPS_COMPLEX CMUMPS_COMPLEX
33#elif MUMPS_ARITH == MUMPS_ARITH_z
34# include "zmumps_c.h"
35# define MUMPS_REAL ZMUMPS_REAL
36# define MUMPS_COMPLEX ZMUMPS_COMPLEX
37#endif
38/*
39 * F_SYM_ARITH is the same as F_SYMBOL (see mumps_common.h) for the symbols
40 * that depend on the arithmetic.
41 * Example: For CMUMPS_XXX, first define
42 * #define CMUMPS_XXX F_SYM_ARITH(xxx,XXX) and then use
43 * CMUMPS_XXX in the code to get rid of any symbol convention annoyance.
44 */
45#if MUMPS_ARITH == MUMPS_ARITH_s
46# if defined(UPPER) || defined(MUMPS_WIN32)
47# define F_SYM_ARITH(lower_case,upper_case) SMUMPS_##upper_case
48# elif defined(Add_)
49# define F_SYM_ARITH(lower_case,upper_case) smumps_##lower_case##_
50# elif defined(Add__)
51# define F_SYM_ARITH(lower_case,upper_case) smumps_##lower_case##__
52# else
53# define F_SYM_ARITH(lower_case,upper_case) smumps_##lower_case
54# endif
55#elif MUMPS_ARITH == MUMPS_ARITH_d
56# if defined(UPPER) || defined(MUMPS_WIN32)
57# define F_SYM_ARITH(lower_case,upper_case) DMUMPS_##upper_case
58# elif defined(Add_)
59# define F_SYM_ARITH(lower_case,upper_case) dmumps_##lower_case##_
60# elif defined(Add__)
61# define F_SYM_ARITH(lower_case,upper_case) dmumps_##lower_case##__
62# else
63# define F_SYM_ARITH(lower_case,upper_case) dmumps_##lower_case
64# endif
65#elif MUMPS_ARITH == MUMPS_ARITH_c
66# if defined(UPPER) || defined(MUMPS_WIN32)
67# define F_SYM_ARITH(lower_case,upper_case) CMUMPS_##upper_case
68# elif defined(Add_)
69# define F_SYM_ARITH(lower_case,upper_case) cmumps_##lower_case##_
70# elif defined(Add__)
71# define F_SYM_ARITH(lower_case,upper_case) cmumps_##lower_case##__
72# else
73# define F_SYM_ARITH(lower_case,upper_case) cmumps_##lower_case
74# endif
75#elif MUMPS_ARITH == MUMPS_ARITH_z
76# if defined(UPPER) || defined(MUMPS_WIN32)
77# define F_SYM_ARITH(lower_case,upper_case) ZMUMPS_##upper_case
78# elif defined(Add_)
79# define F_SYM_ARITH(lower_case,upper_case) zmumps_##lower_case##_
80# elif defined(Add__)
81# define F_SYM_ARITH(lower_case,upper_case) zmumps_##lower_case##__
82# else
83# define F_SYM_ARITH(lower_case,upper_case) zmumps_##lower_case
84# endif
85#endif
86#define MUMPS_F77 \
87 F_SYM_ARITH(f77,F77)
88void MUMPS_CALL
89MUMPS_F77( MUMPS_INT *job,
90 MUMPS_INT *sym,
91 MUMPS_INT *par,
92 MUMPS_INT *comm_fortran,
93 MUMPS_INT *n,
94 MUMPS_INT *nblk,
95 MUMPS_INT *icntl,
96 MUMPS_REAL *cntl,
97 MUMPS_INT *keep,
98 MUMPS_REAL *dkeep,
99 MUMPS_INT8 *keep8,
100 MUMPS_INT *nz,
101 MUMPS_INT8 *nnz,
102 MUMPS_INT *irn,
103 MUMPS_INT *irn_avail,
104 MUMPS_INT *jcn,
105 MUMPS_INT *jcn_avail,
106 MUMPS_COMPLEX *a,
107 MUMPS_INT *a_avail,
108 MUMPS_INT *nz_loc,
109 MUMPS_INT8 *nnz_loc,
110 MUMPS_INT *irn_loc,
111 MUMPS_INT *irn_loc_avail,
112 MUMPS_INT *jcn_loc,
113 MUMPS_INT *jcn_loc_avail,
114 MUMPS_COMPLEX *a_loc,
115 MUMPS_INT *a_loc_avail,
116 MUMPS_INT *nelt,
117 MUMPS_INT *eltptr,
118 MUMPS_INT *eltptr_avail,
119 MUMPS_INT *eltvar,
120 MUMPS_INT *eltvar_avail,
121 MUMPS_COMPLEX *a_elt,
122 MUMPS_INT *a_elt_avail,
123 MUMPS_INT *blkptr,
124 MUMPS_INT *blkptr_avail,
125 MUMPS_INT *blkvar,
126 MUMPS_INT *blkvar_avail,
127 MUMPS_INT *perm_in,
128 MUMPS_INT *perm_in_avail,
129 MUMPS_COMPLEX *rhs,
130 MUMPS_INT *rhs_avail,
131 MUMPS_COMPLEX *redrhs,
132 MUMPS_INT *redrhs_avail,
133 MUMPS_INT *info,
134 MUMPS_REAL *rinfo,
135 MUMPS_INT *infog,
136 MUMPS_REAL *rinfog,
137 MUMPS_INT *deficiency,
138 MUMPS_INT *lwk_user,
139 MUMPS_INT *size_schur,
140 MUMPS_INT *listvar_schur,
141 MUMPS_INT *listvar_schur_avail,
142 MUMPS_COMPLEX *schur,
143 MUMPS_INT *schur_avail,
144 MUMPS_COMPLEX *wk_user,
145 MUMPS_INT *wk_user_avail,
146 MUMPS_REAL *colsca,
147 MUMPS_INT *colsca_avail,
148 MUMPS_REAL *rowsca,
149 MUMPS_INT *rowsca_avail,
150 MUMPS_INT *instance_number,
151 MUMPS_INT *nrhs,
152 MUMPS_INT *lrhs,
153 MUMPS_INT *lredrhs,
154 MUMPS_COMPLEX *rhs_sparse,
155 MUMPS_INT *rhs_sparse_avail,
156 MUMPS_COMPLEX *sol_loc,
157 MUMPS_INT *sol_loc_avail,
158 MUMPS_COMPLEX *rhs_loc,
159 MUMPS_INT *rhs_loc_avail,
160 MUMPS_INT *irhs_sparse,
161 MUMPS_INT *irhs_sparse_avail,
162 MUMPS_INT *irhs_ptr,
163 MUMPS_INT *irhs_ptr_avail,
164 MUMPS_INT *isol_loc,
165 MUMPS_INT *isol_loc_avail,
166 MUMPS_INT *irhs_loc,
167 MUMPS_INT *irhs_loc_avail,
168 MUMPS_INT *nz_rhs,
169 MUMPS_INT *lsol_loc,
170 MUMPS_INT *nloc_rhs,
171 MUMPS_INT *lrhs_loc,
172 MUMPS_INT *schur_mloc,
173 MUMPS_INT *schur_nloc,
174 MUMPS_INT *schur_lld,
175 MUMPS_INT *schur_mblock,
176 MUMPS_INT *schur_nblock,
177 MUMPS_INT *schur_nprow,
178 MUMPS_INT *schur_npcol,
179 MUMPS_INT *ooc_tmpdir,
180 MUMPS_INT *ooc_prefix,
181 MUMPS_INT *write_problem,
182 MUMPS_INT *save_dir,
183 MUMPS_INT *save_prefix,
184 MUMPS_INT *ooc_tmpdirlen,
185 MUMPS_INT *ooc_prefixlen,
186 MUMPS_INT *write_problemlen,
187 MUMPS_INT *save_dirlen,
188 MUMPS_INT *save_prefixlen,
189 MUMPS_INT *metis_options
190 );
191/*
192 * COLSCA and ROWSCA are static. They are passed inside cmumps_f77 but
193 * might also be changed on return by MUMPS_ASSIGN_COLSCA/ROWSCA
194 * NB: They are put here because they use MUMPS_REAL and need thus
195 * one symbol per arithmetic.
196 */
197#if MUMPS_ARITH == MUMPS_ARITH_s
198# define MUMPS_COLSCA_STATIC SMUMPS_COLSCA_STATIC
199# define MUMPS_ROWSCA_STATIC SMUMPS_ROWSCA_STATIC
200#elif MUMPS_ARITH == MUMPS_ARITH_d
201# define MUMPS_COLSCA_STATIC DMUMPS_COLSCA_STATIC
202# define MUMPS_ROWSCA_STATIC DMUMPS_ROWSCA_STATIC
203#elif MUMPS_ARITH == MUMPS_ARITH_c
204# define MUMPS_COLSCA_STATIC CMUMPS_COLSCA_STATIC
205# define MUMPS_ROWSCA_STATIC CMUMPS_ROWSCA_STATIC
206#elif MUMPS_ARITH == MUMPS_ARITH_z
207# define MUMPS_COLSCA_STATIC ZMUMPS_COLSCA_STATIC
208# define MUMPS_ROWSCA_STATIC ZMUMPS_ROWSCA_STATIC
209#endif
210static MUMPS_REAL * MUMPS_COLSCA_STATIC;
211static MUMPS_REAL * MUMPS_ROWSCA_STATIC;
212#define MUMPS_ASSIGN_COLSCA \
213 F_SYM_ARITH(assign_colsca,ASSIGN_COLSCA)
214void MUMPS_CALL
215MUMPS_ASSIGN_COLSCA(MUMPS_REAL * f77colsca)
216{
217 MUMPS_COLSCA_STATIC = f77colsca;
218}
219#define MUMPS_NULLIFY_C_COLSCA \
220 F_SYM_ARITH(nullify_c_colsca,NULLIFY_C_COLSCA)
221void MUMPS_CALL
226#define MUMPS_ASSIGN_ROWSCA \
227 F_SYM_ARITH(assign_rowsca,ASSIGN_ROWSCA)
228void MUMPS_CALL
229MUMPS_ASSIGN_ROWSCA(MUMPS_REAL * f77rowsca)
230{
231 MUMPS_ROWSCA_STATIC = f77rowsca;
232}
233#define MUMPS_NULLIFY_C_ROWSCA \
234 F_SYM_ARITH(nullify_c_rowsca,NULLIFY_C_ROWSCA)
235void MUMPS_CALL
240/* FIXME: move CMUMPS_SET_TMP_PTR to another file */
241#define MUMPS_SET_TMP_PTR \
242 F_SYM_ARITH(set_tmp_ptr,SET_TMP_PTR) /* Fortran routine <arith>MUMPS_SET_TMP_PTR called from C */
243#define MUMPS_SET_TMP_PTR_C \
244 F_SYM_ARITH(set_tmp_ptr_c,SET_TMP_PTR_C) /* C routine <arith>MUMPS_SET_TMP_PTR_C called from Fortran */
245void MUMPS_SET_TMP_PTR(void *x, MUMPS_INT8 * size);
246void MUMPS_CALL MUMPS_SET_TMP_PTR_C(MUMPS_INT8 *addr_ptr, MUMPS_INT8 *size) /* called from Fortran */
247{
248/*
249 MUMPS_SET_TMP_PTR sets a static Fortran pointer from an address and a size:
250 size is passed by address
251 The address passed in *addr_ptr, however, *addr_ptr is a MUMPS_INT8
252 addr_ptr is the pointer to the address we want to pass
253 We cast addr_ptr to a pointer to an address before taking the content
254 *(void *)addr_ptr)
255*/
256 MUMPS_SET_TMP_PTR(*(void**)addr_ptr, size); /* calls Fortran */
257}
258#if MUMPS_ARITH == MUMPS_ARITH_s
259# define mumps_c smumps_c
260# define MUMPS_STRUC_C SMUMPS_STRUC_C
261#elif MUMPS_ARITH == MUMPS_ARITH_d
262# define mumps_c dmumps_c
263# define MUMPS_STRUC_C DMUMPS_STRUC_C
264#elif MUMPS_ARITH == MUMPS_ARITH_c
265# define mumps_c cmumps_c
266# define MUMPS_STRUC_C CMUMPS_STRUC_C
267#elif MUMPS_ARITH == MUMPS_ARITH_z
268# define mumps_c zmumps_c
269# define MUMPS_STRUC_C ZMUMPS_STRUC_C
270#endif
271void MUMPS_CALL
272mumps_c(MUMPS_STRUC_C * mumps_par)
273{
274 /*
275 * The following local variables will
276 * be passed to the F77 interface.
277 */
278 MUMPS_INT *icntl;
279 MUMPS_REAL *cntl;
280 MUMPS_INT *keep;
281 MUMPS_REAL *dkeep;
282 MUMPS_INT8 *keep8;
283 MUMPS_INT *irn; MUMPS_INT *jcn; MUMPS_COMPLEX *a;
284 MUMPS_INT *irn_loc; MUMPS_INT *jcn_loc; MUMPS_COMPLEX *a_loc;
285 MUMPS_INT *eltptr, *eltvar; MUMPS_COMPLEX *a_elt;
286 MUMPS_INT *blkptr; MUMPS_INT *blkvar;
287 MUMPS_INT *perm_in; MUMPS_INT perm_in_avail;
288 MUMPS_INT *listvar_schur; MUMPS_INT listvar_schur_avail;
289 MUMPS_COMPLEX *schur; MUMPS_INT schur_avail;
290 MUMPS_COMPLEX *rhs; MUMPS_COMPLEX *redrhs;
291 MUMPS_COMPLEX *wk_user; MUMPS_INT wk_user_avail;
292 MUMPS_REAL *colsca; MUMPS_REAL *rowsca;
293 MUMPS_COMPLEX *rhs_sparse, *sol_loc, *rhs_loc;
294 MUMPS_INT *irhs_sparse, *irhs_ptr, *isol_loc, *irhs_loc;
295 MUMPS_INT irn_avail, jcn_avail, a_avail, rhs_avail, redrhs_avail;
296 /* These are actually used
297 * as booleans, but we stick
298 * to simple types for the
299 * C-F77 interface */
300 MUMPS_INT irn_loc_avail, jcn_loc_avail, a_loc_avail;
301 MUMPS_INT eltptr_avail, eltvar_avail, a_elt_avail;
302 MUMPS_INT blkptr_avail, blkvar_avail;
303 MUMPS_INT colsca_avail, rowsca_avail;
304 MUMPS_INT irhs_ptr_avail, rhs_sparse_avail, sol_loc_avail, rhs_loc_avail;
305 MUMPS_INT irhs_sparse_avail, isol_loc_avail, irhs_loc_avail;
306 MUMPS_INT *info; MUMPS_INT *infog;
307 MUMPS_REAL *rinfo; MUMPS_REAL *rinfog;
308 MUMPS_INT ooc_tmpdir[255]; MUMPS_INT ooc_prefix[63];
309 MUMPS_INT write_problem[255];
310 MUMPS_INT save_dir[255]; MUMPS_INT save_prefix[255];
311 /* Other local variables */
312 MUMPS_INT idummy; MUMPS_INT *idummyp;
313 MUMPS_REAL rdummy; MUMPS_REAL *rdummyp;
314 MUMPS_COMPLEX cdummy; MUMPS_COMPLEX *cdummyp;
315 /* String lengths to be passed to Fortran by address */
316 MUMPS_INT ooc_tmpdirlen;
317 MUMPS_INT ooc_prefixlen;
318 MUMPS_INT save_dirlen;
319 MUMPS_INT save_prefixlen;
320 MUMPS_INT write_problemlen;
321 MUMPS_INT *metis_options;
322 int i;
323 static const MUMPS_INT no = 0;
324 static const MUMPS_INT yes = 1;
325 idummyp = &idummy;
326 cdummyp = &cdummy;
327 rdummyp = &rdummy;
328 /* [SDCZ]MUMPS_F77 always calls either
329 * MUMPS_NULLIFY_C_COLSCA or MUMPS_ASSIGN_C_COLSCA
330 * (and ROWSCA). The next two lines are thus not
331 * strictly necessary. */
332 MUMPS_COLSCA_STATIC=0;
333 MUMPS_ROWSCA_STATIC=0;
334 /* Initialize pointers to zero for job == -1 */
335 if ( mumps_par->job == -1 )
336 { /* job = -1: we just reset all pointers to 0 */
337 mumps_par->irn=0; mumps_par->jcn=0; mumps_par->a=0; mumps_par->rhs=0; mumps_par->wk_user=0;
338 mumps_par->redrhs=0;
339 mumps_par->eltptr=0; mumps_par->eltvar=0; mumps_par->a_elt=0; mumps_par->blkptr=0; mumps_par->blkvar=0; mumps_par->perm_in=0; mumps_par->sym_perm=0; mumps_par->uns_perm=0; mumps_par->irn_loc=0;mumps_par->jcn_loc=0;mumps_par->a_loc=0; mumps_par->listvar_schur=0;mumps_par->schur=0;mumps_par->mapping=0;mumps_par->pivnul_list=0;mumps_par->colsca=0;mumps_par->colsca_from_mumps=0;mumps_par->rowsca=0;mumps_par->rowsca_from_mumps=0; mumps_par->rhs_sparse=0; mumps_par->irhs_sparse=0; mumps_par->sol_loc=0; mumps_par->rhs_loc=0; mumps_par->irhs_ptr=0; mumps_par->isol_loc=0; mumps_par->irhs_loc=0;
340 strcpy(mumps_par->ooc_tmpdir,"NAME_NOT_INITIALIZED");
341 strcpy(mumps_par->ooc_prefix,"NAME_NOT_INITIALIZED");
342 strcpy(mumps_par->write_problem,"NAME_NOT_INITIALIZED");
343 strcpy(mumps_par->save_dir,"NAME_NOT_INITIALIZED");
344 strcpy(mumps_par->save_prefix,"NAME_NOT_INITIALIZED");
345 strncpy(mumps_par->version_number,MUMPS_VERSION,MUMPS_VERSION_MAX_LEN);
346 mumps_par->version_number[MUMPS_VERSION_MAX_LEN+1] = '\0';
347 /* Next line initializes scalars to arbitrary values.
348 * Some of those will anyway be overwritten during the
349 * call to Fortran routine [SDCZ]MUMPS_INIT_PHASE */
350 mumps_par->n=0; mumps_par->nblk=0; mumps_par->nz=0; mumps_par->nnz=0; mumps_par->nz_loc=0; mumps_par->nnz_loc=0; mumps_par->nelt=0;mumps_par->instance_number=0;mumps_par->deficiency=0;mumps_par->lwk_user=0;mumps_par->size_schur=0;mumps_par->lrhs=0; mumps_par->lredrhs=0; mumps_par->nrhs=0; mumps_par->nz_rhs=0; mumps_par->lsol_loc=0; mumps_par->nloc_rhs=0; mumps_par->lrhs_loc=0;
351 mumps_par->schur_mloc=0; mumps_par->schur_nloc=0; mumps_par->schur_lld=0; mumps_par->mblock=0; mumps_par->nblock=0; mumps_par->nprow=0; mumps_par->npcol=0;
352 }
353 ooc_tmpdirlen=(int)strlen(mumps_par->ooc_tmpdir);
354 ooc_prefixlen=(int)strlen(mumps_par->ooc_prefix);
355 write_problemlen=(int)strlen(mumps_par->write_problem);
356 save_dirlen =(int)strlen(mumps_par->save_dir);
357 save_prefixlen=(int)strlen(mumps_par->save_prefix);
358 /* Avoid the use of strnlen which may not be
359 * available on all systems. Allow strings without
360 * \0 at the end, if the file is not found, the
361 * Fortran layer is responsible for raising an
362 * error. */
363 if(ooc_tmpdirlen > 255){
364 ooc_tmpdirlen=255;
365 }
366 if(ooc_prefixlen > 63){
367 ooc_prefixlen=63;
368 }
369 if(write_problemlen > 255){
370 write_problemlen=255;
371 }
372 if(save_dirlen > 255){
373 save_dirlen=255;
374 }
375 if(save_prefixlen > 255){
376 save_prefixlen=255;
377 }
378 /*
379 * Extract info from the C structure to call the F77 interface. The
380 * following macro avoids repeating the same code with risks of errors.
381 */
382#define EXTRACT_POINTERS(component,dummypointer) \
383 if ( mumps_par-> component == 0) \
384 { component = dummypointer; \
385 component ## _avail = no; } \
386 else \
387 { component = mumps_par-> component; \
388 component ## _avail = yes; }
389 /*
390 * For example, EXTRACT_POINTERS(irn,idummyp) produces the following line of code:
391 if (mumps_par->irn== 0) {irn= idummyp;irn_avail = no; } else { irn = mumps_par->irn;irn_avail = yes; } ;
392 * which says that irn is set to mumps_par->irn except if
393 * mumps_par->irn is 0, which means that it is not available.
394 */
395 EXTRACT_POINTERS(irn,idummyp);
396 EXTRACT_POINTERS(jcn,idummyp);
397 EXTRACT_POINTERS(rhs,cdummyp);
398 EXTRACT_POINTERS(wk_user,cdummyp);
399 EXTRACT_POINTERS(redrhs,cdummyp);
400 EXTRACT_POINTERS(irn_loc,idummyp);
401 EXTRACT_POINTERS(jcn_loc,idummyp);
402 EXTRACT_POINTERS(a_loc,cdummyp);
403 EXTRACT_POINTERS(a,cdummyp);
404 EXTRACT_POINTERS(eltptr,idummyp);
405 EXTRACT_POINTERS(eltvar,idummyp);
406 EXTRACT_POINTERS(a_elt,cdummyp);
407 EXTRACT_POINTERS(blkptr,idummyp);
408 EXTRACT_POINTERS(blkvar,idummyp);
409 EXTRACT_POINTERS(perm_in,idummyp);
410 EXTRACT_POINTERS(listvar_schur,idummyp);
411 EXTRACT_POINTERS(schur,cdummyp);
412 /* EXTRACT_POINTERS not adapted to rowsca and colsca */
413 if ( mumps_par->rowsca != 0 && mumps_par->rowsca_from_mumps == 0 )
414 {
415 /* has been set by user and was not allocated in mumps */
416 rowsca = mumps_par-> rowsca;
417 rowsca_avail = yes;
418 }
419 else
420 {
421 /* Changing the rowsca pointer in C after an earlier call
422 where rowsca was allocated by mumps is not possible.
423 FIXME: check if the content of rowsca could still be
424 modified by the user -- with ICNTL(8) set to -1 --
425 before calling the next factorization step again. */
426 rowsca = rdummyp;
427 rowsca_avail = no;
428 }
429 if ( mumps_par->colsca != 0 && mumps_par->colsca_from_mumps == 0 )
430 /* has been changed by user and was not allocated in mumps */
431 {
432 colsca = mumps_par-> colsca;
433 colsca_avail = yes;
434 }
435 else
436 {
437 /* Changing the colsca pointer in C after an earlier call
438 where colsca was allocated by mumps is not possible.
439 FIXME: check if the content of colsca could still be
440 modified by the user -- with ICNTL(8) set to -1 --
441 before calling the next factorization step again. */
442 colsca = rdummyp;
443 colsca_avail = no;
444 }
445 EXTRACT_POINTERS(rhs_sparse,cdummyp);
446 EXTRACT_POINTERS(sol_loc,cdummyp);
447 EXTRACT_POINTERS(rhs_loc,cdummyp);
448 EXTRACT_POINTERS(irhs_sparse,idummyp);
449 EXTRACT_POINTERS(isol_loc,idummyp);
450 EXTRACT_POINTERS(irhs_loc,idummyp);
451 EXTRACT_POINTERS(irhs_ptr,idummyp);
452 /* printf("irn_avail,jcn_avail, rhs_avail, a_avail, eltptr_avail, eltvar_avail,a_elt_avail,perm_in_avail= %d %d %d %d %d %d %d \n", irn_avail,jcn_avail, rhs_avail, a_avail, eltptr_avail, eltvar_avail, a_elt_avail, perm_in_avail); */
453 /*
454 * Extract integers (input) or pointers that are
455 * always allocated (such as ICNTL, INFO, ...)
456 */
457 /* size_schur = mumps_par->size_schur; */
458 /* instance_number = mumps_par->instance_number; */
459 icntl = mumps_par->icntl;
460 cntl = mumps_par->cntl;
461 keep = mumps_par->keep;
462 dkeep = mumps_par->dkeep;
463 keep8 = mumps_par->keep8;
464 info = mumps_par->info;
465 infog = mumps_par->infog;
466 rinfo = mumps_par->rinfo;
467 rinfog = mumps_par->rinfog;
468 for(i=0;i<ooc_tmpdirlen;i++){
469 ooc_tmpdir[i]=(int)mumps_par->ooc_tmpdir[i];
470 }
471 for(i=0;i<ooc_prefixlen;i++){
472 ooc_prefix[i]=(int)mumps_par->ooc_prefix[i];
473 }
474 for(i=0;i<write_problemlen;i++){
475 write_problem[i]=(int)mumps_par->write_problem[i];
476 }
477 for(i=0;i<save_dirlen;i++){
478 save_dir[i]=(int)mumps_par->save_dir[i];
479 }
480 for(i=0;i<save_prefixlen;i++){
481 save_prefix[i]=(int)mumps_par->save_prefix[i];
482 }
483 metis_options = mumps_par->metis_options;
484 /* Call F77 interface */
485 MUMPS_F77(&(mumps_par->job), &(mumps_par->sym), &(mumps_par->par), &(mumps_par->comm_fortran),
486 &(mumps_par->n), &(mumps_par->nblk), icntl, cntl, keep, dkeep, keep8,
487 &(mumps_par->nz), &(mumps_par->nnz), irn, &irn_avail, jcn, &jcn_avail, a, &a_avail,
488 &(mumps_par->nz_loc), &(mumps_par->nnz_loc), irn_loc, &irn_loc_avail, jcn_loc, &jcn_loc_avail,
489 a_loc, &a_loc_avail,
490 &(mumps_par->nelt), eltptr, &eltptr_avail, eltvar, &eltvar_avail, a_elt, &a_elt_avail, blkptr, &blkptr_avail, blkvar, &blkvar_avail,
491 perm_in, &perm_in_avail,
492 rhs, &rhs_avail, redrhs, &redrhs_avail, info, rinfo, infog, rinfog,
493 &(mumps_par->deficiency), &(mumps_par->lwk_user), &(mumps_par->size_schur), listvar_schur, &listvar_schur_avail, schur,
494 &schur_avail, wk_user, &wk_user_avail, colsca, &colsca_avail, rowsca, &rowsca_avail,
495 &(mumps_par->instance_number), &(mumps_par->nrhs), &(mumps_par->lrhs),
496 &(mumps_par->lredrhs),
497 rhs_sparse, &rhs_sparse_avail, sol_loc, &sol_loc_avail, rhs_loc, &rhs_loc_avail, irhs_sparse,
498 &irhs_sparse_avail, irhs_ptr, &irhs_ptr_avail, isol_loc,
499 &isol_loc_avail, irhs_loc, &irhs_loc_avail, &(mumps_par->nz_rhs), &(mumps_par->lsol_loc), &(mumps_par->lrhs_loc), &(mumps_par->nloc_rhs)
500 , &(mumps_par->schur_mloc)
501 , &(mumps_par->schur_nloc)
502 , &(mumps_par->schur_lld)
503 , &(mumps_par->mblock)
504 , &(mumps_par->nblock)
505 , &(mumps_par->nprow)
506 , &(mumps_par->npcol)
507 , ooc_tmpdir
508 , ooc_prefix
509 , write_problem
510 , save_dir
511 , save_prefix
512 , &ooc_tmpdirlen
513 , &ooc_prefixlen
514 , &write_problemlen
515 , &save_dirlen
516 , &save_prefixlen
517 , metis_options
518 );
519 /*
520 * Set interface to C (KEEP(500)=1) after job=-1
521 */
522 if ( mumps_par->job == -1 )
523 {
524 mumps_par->keep[499]=1;
525 }
526 /*
527 * mapping and pivnul_list are usually 0 except if
528 * MUMPS_ASSIGN_MAPPING/MUMPS_ASSIGN_PIVNUL_LIST was called.
529 */
530 mumps_par->mapping=mumps_get_mapping();
531 mumps_par->pivnul_list=mumps_get_pivnul_list();
532 /* to get permutations computed during analysis */
533 mumps_par->sym_perm=mumps_get_sym_perm();
534 mumps_par->uns_perm=mumps_get_uns_perm();
535 /*
536 * colsca/rowsca can either be user data or have been modified
537 * within mumps by calls to MUMPS_ASSIGN_COLSCA and/or
538 * MUMPS_ASSIGN_ROWSCA. In all cases their address is contained
539 * in MUMPS_COLSCA_STATIC and/or MUMPS_ROWSCA_STATIC.
540 *
541 * In case of a null pointer, we also reset mumps_par->rowsca/colsca
542 * to 0 (case of JOB=-2, the Fortran pointer will be NULL but the
543 * C pointer should also be null.
544 */
545 if (rowsca_avail == no) {
546 mumps_par->rowsca = MUMPS_ROWSCA_STATIC;
547 if (MUMPS_ROWSCA_STATIC) {
548 /* remember that row Scaling was computed by MUMPS */
549 mumps_par->rowsca_from_mumps=1;
550 }
551 }
552 if (colsca_avail == no) {
553 mumps_par->colsca = MUMPS_COLSCA_STATIC;
554 if (MUMPS_COLSCA_STATIC) {
555 /* remember that column Scaling was computed by MUMPS */
556 mumps_par->colsca_from_mumps=1;
557 }
558 }
559 /*
560 * Decode OOC_TMPDIR and OOC_PREFIX
561 */
562 for(i=0;i<ooc_tmpdirlen;i++){
563 mumps_par->ooc_tmpdir[i]=(char)ooc_tmpdir[i];
564 }
565 mumps_par->ooc_tmpdir[ooc_tmpdirlen]='\0';
566 for(i=0;i<ooc_prefixlen;i++){
567 mumps_par->ooc_prefix[i]=(char)ooc_prefix[i];
568 }
569 mumps_par->ooc_prefix[ooc_prefixlen]='\0';
570}
cmumps_c.h
MUMPS_VERSION_MAX_LEN
#define MUMPS_VERSION_MAX_LEN
Definition cmumps_c.h:35
MUMPS_VERSION
#define MUMPS_VERSION
Definition cmumps_c.h:32
dmumps_c.h
MUMPS_SET_TMP_PTR
#define MUMPS_SET_TMP_PTR
Definition mumps_c.c:241
MUMPS_F77
#define MUMPS_F77
Definition mumps_c.c:86
MUMPS_ASSIGN_COLSCA
#define MUMPS_ASSIGN_COLSCA
Definition mumps_c.c:212
MUMPS_REAL
#define MUMPS_REAL
Definition mumps_c.c:23
MUMPS_COLSCA_STATIC
static MUMPS_REAL * MUMPS_COLSCA_STATIC
Definition mumps_c.c:210
MUMPS_COMPLEX
#define MUMPS_COMPLEX
Definition mumps_c.c:24
MUMPS_NULLIFY_C_COLSCA
#define MUMPS_NULLIFY_C_COLSCA
Definition mumps_c.c:222
MUMPS_NULLIFY_C_ROWSCA
#define MUMPS_NULLIFY_C_ROWSCA
Definition mumps_c.c:236
MUMPS_ASSIGN_ROWSCA
#define MUMPS_ASSIGN_ROWSCA
Definition mumps_c.c:226
mumps_c
void MUMPS_CALL mumps_c(MUMPS_STRUC_C *mumps_par)
Definition mumps_c.c:272
EXTRACT_POINTERS
#define EXTRACT_POINTERS(component, dummypointer)
MUMPS_ROWSCA_STATIC
static MUMPS_REAL * MUMPS_ROWSCA_STATIC
Definition mumps_c.c:211
MUMPS_SET_TMP_PTR_C
#define MUMPS_SET_TMP_PTR_C
Definition mumps_c.c:243
MUMPS_INT8
#define MUMPS_INT8
Definition mumps_c_types.h:35
MUMPS_INT
#define MUMPS_INT
Definition mumps_c_types.h:32
mumps_get_mapping
MUMPS_INT * mumps_get_mapping()
Definition mumps_common.c:25
mumps_get_uns_perm
MUMPS_INT * mumps_get_uns_perm()
Definition mumps_common.c:70
mumps_get_sym_perm
MUMPS_INT * mumps_get_sym_perm()
Definition mumps_common.c:55
mumps_get_pivnul_list
MUMPS_INT * mumps_get_pivnul_list()
Definition mumps_common.c:40
mumps_common.h
MUMPS_CALL
#define MUMPS_CALL
Definition mumps_compat.h:35
x
x
Definition schur_example.m:53
n
n
Definition schur_example.m:9
smumps_c.h
zmumps_c.h