~ubuntu-branches/ubuntu/precise/code-saturne/precise

« back to all changes in this revision

Viewing changes to src/base/cs_sles.c

  • Committer: Package Import Robot
  • Author(s): Sylvestre Ledru
  • Date: 2011-11-24 00:00:08 UTC
  • mfrom: (6.1.9 sid)
  • Revision ID: package-import@ubuntu.com-20111124000008-2vo99e38267942q5
Tags: 2.1.0-3
Install a missing file

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
/*============================================================================
2
 
 *
3
 
 *     This file is part of the Code_Saturne Kernel, element of the
4
 
 *     Code_Saturne CFD tool.
5
 
 *
6
 
 *     Copyright (C) 1998-2009 EDF S.A., France
7
 
 *
8
 
 *     contact: saturne-support@edf.fr
9
 
 *
10
 
 *     The Code_Saturne Kernel is free software; you can redistribute it
11
 
 *     and/or modify it under the terms of the GNU General Public License
12
 
 *     as published by the Free Software Foundation; either version 2 of
13
 
 *     the License, or (at your option) any later version.
14
 
 *
15
 
 *     The Code_Saturne Kernel is distributed in the hope that it will be
16
 
 *     useful, but WITHOUT ANY WARRANTY; without even the implied warranty
17
 
 *     of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18
 
 *     GNU General Public License for more details.
19
 
 *
20
 
 *     You should have received a copy of the GNU General Public License
21
 
 *     along with the Code_Saturne Kernel; if not, write to the
22
 
 *     Free Software Foundation, Inc.,
23
 
 *     51 Franklin St, Fifth Floor,
24
 
 *     Boston, MA  02110-1301  USA
25
 
 *
26
 
 *============================================================================*/
27
 
 
28
 
/*============================================================================
29
 
 * Sparse Linear Equation Solvers
30
 
 *============================================================================*/
31
 
 
32
 
#if defined(HAVE_CONFIG_H)
33
 
#include "cs_config.h"
34
 
#endif
35
 
 
36
 
/*----------------------------------------------------------------------------
37
 
 * Standard C library headers
38
 
 *----------------------------------------------------------------------------*/
39
 
 
40
 
#include <stdarg.h>
41
 
#include <stdio.h>
42
 
#include <stdlib.h>
43
 
#include <string.h>
44
 
#include <assert.h>
45
 
#include <math.h>
46
 
 
47
 
#if defined(HAVE_MPI)
48
 
#include <mpi.h>
49
 
#endif
50
 
 
51
 
/*----------------------------------------------------------------------------
52
 
 * BFT library headers
53
 
 *----------------------------------------------------------------------------*/
54
 
 
55
 
#include <bft_mem.h>
56
 
#include <bft_error.h>
57
 
#include <bft_printf.h>
58
 
#include <bft_timer.h>
59
 
 
60
 
/*----------------------------------------------------------------------------
61
 
 * FVM library headers
62
 
 *----------------------------------------------------------------------------*/
63
 
 
64
 
/*----------------------------------------------------------------------------
65
 
 * Local headers
66
 
 *----------------------------------------------------------------------------*/
67
 
 
68
 
#include "cs_base.h"
69
 
#include "cs_blas.h"
70
 
#include "cs_mesh.h"
71
 
#include "cs_matrix.h"
72
 
#include "cs_perio.h"
73
 
#include "cs_post.h"
74
 
 
75
 
/*----------------------------------------------------------------------------
76
 
 *  Header for the current file
77
 
 *----------------------------------------------------------------------------*/
78
 
 
79
 
#include "cs_sles.h"
80
 
 
81
 
/*----------------------------------------------------------------------------*/
82
 
 
83
 
BEGIN_C_DECLS
84
 
 
85
 
/*=============================================================================
86
 
 * Local Macro Definitions
87
 
 *============================================================================*/
88
 
 
89
 
#define EPZERO  1.E-12
90
 
#define RINFIN  1.E+30
91
 
 
92
 
#if !defined(HUGE_VAL)
93
 
#define HUGE_VAL  1.E+12
94
 
#endif
95
 
 
96
 
/*=============================================================================
97
 
 * Local Structure Definitions
98
 
 *============================================================================*/
99
 
 
100
 
/* Basic per linear system options and logging */
101
 
/*---------------------------------------------*/
102
 
 
103
 
typedef struct _cs_sles_info_t {
104
 
 
105
 
  char                *name;               /* System name */
106
 
  cs_sles_type_t       type;               /* Solver type */
107
 
 
108
 
  unsigned             n_calls;            /* Number of times system solved */
109
 
 
110
 
  unsigned             n_iterations_last;  /* Number of iterations for last
111
 
                                              system resolution */
112
 
  unsigned             n_iterations_min;   /* Minimum number ot iterations
113
 
                                              in system resolution history */
114
 
  unsigned             n_iterations_max;   /* Maximum number ot iterations
115
 
                                              in system resolution history */
116
 
  unsigned long long   n_iterations_tot;   /* Total accumulated number of
117
 
                                              iterations */
118
 
 
119
 
  double               wt_tot;             /* Total wall-clock time used */
120
 
  double               cpu_tot;            /* Total (local) CPU used */
121
 
 
122
 
} cs_sles_info_t;
123
 
 
124
 
/* Convergence testing and tracking */
125
 
/*----------------------------------*/
126
 
 
127
 
typedef struct _cs_sles_convergence_t {
128
 
 
129
 
  int                  verbosity;          /* Verbosity level */
130
 
 
131
 
  unsigned             n_iterations;       /* Current number of iterations */
132
 
  unsigned             n_iterations_max;   /* Maximum number of iterations */
133
 
 
134
 
  double               precision;          /* Precision limit */
135
 
  double               r_norm;             /* Residue normalization */
136
 
  double               residue;            /* Current residue */
137
 
  double               initial_residue;    /* Initial residue */
138
 
 
139
 
} cs_sles_convergence_t;
140
 
 
141
 
/*============================================================================
142
 
 *  Global variables
143
 
 *============================================================================*/
144
 
 
145
 
static int cs_glob_sles_n_systems = 0;      /* Current number of systems */
146
 
static int cs_glob_sles_n_max_systems = 0;  /* Max. number of sytems for
147
 
                                               cs_glob_sles_systems. */
148
 
 
149
 
static cs_sles_info_t **cs_glob_sles_systems = NULL; /* System info array */
150
 
 
151
 
/*
152
 
  Matrix structures re-used for various resolutions.
153
 
 
154
 
  These structures are kept throughout the whole run, to avoid paying the
155
 
  CPU overhead for their construction at each system resolution
156
 
  (at the cost of extra memory use, depending on the chosen structure).
157
 
 
158
 
  Two simultaneous matrixes may be needed for some solvers: one for the
159
 
  linear system, one for the preconditionner.
160
 
  We always have at least one structure of "native" matrix type, as
161
 
  this type incurs negligible memory and assignment cpu overhead;
162
 
  we use it for Jacobi (where the number of iterations done is often
163
 
  small, and an assignment cost equivalent to a few matrix.vector
164
 
  products may not be amortized).
165
 
*/
166
 
 
167
 
cs_matrix_t *cs_glob_sles_base_matrix = NULL;
168
 
cs_matrix_t *cs_glob_sles_native_matrix = NULL;
169
 
 
170
 
/* Sparse linear equation solver type names */
171
 
 
172
 
/* Short names for solver types */
173
 
 
174
 
const char *cs_sles_type_name[] = {N_("Conjugate gradient"),
175
 
                                   N_("Jacobi"),
176
 
                                   N_("Bi-CGstab")};
177
 
 
178
 
/*============================================================================
179
 
 * Private function definitions
180
 
 *============================================================================*/
181
 
 
182
 
/*----------------------------------------------------------------------------
183
 
 * Return pointer to new linear system info structure.
184
 
 *
185
 
 * parameters:
186
 
 *   name <-- system name
187
 
 *   type <-- resolution method
188
 
 *
189
 
 * returns:
190
 
 *   pointer to newly created linear system info structure
191
 
 *----------------------------------------------------------------------------*/
192
 
 
193
 
static cs_sles_info_t *
194
 
_sles_info_create(const char      *name,
195
 
                  cs_sles_type_t   type)
196
 
{
197
 
  cs_sles_info_t *new_info = NULL;
198
 
 
199
 
  BFT_MALLOC(new_info, 1, cs_sles_info_t);
200
 
  BFT_MALLOC(new_info->name, strlen(name) + 1, char);
201
 
 
202
 
  strcpy(new_info->name, name);
203
 
  new_info->type = type;
204
 
 
205
 
  new_info->n_calls = 0;
206
 
  new_info->n_iterations_min = 0;
207
 
  new_info->n_iterations_max = 0;
208
 
  new_info->n_iterations_last = 0;
209
 
  new_info->n_iterations_tot = 0;
210
 
 
211
 
  new_info->wt_tot = 0.0;
212
 
  new_info->cpu_tot = 0.0;
213
 
 
214
 
  return new_info;
215
 
}
216
 
 
217
 
/*----------------------------------------------------------------------------
218
 
 * Destroy linear system info structure.
219
 
 *
220
 
 * parameters:
221
 
 *   this_info <-> pointer to linear system info structure pointer
222
 
 *----------------------------------------------------------------------------*/
223
 
 
224
 
static void
225
 
_sles_info_destroy(cs_sles_info_t  **this_info)
226
 
{
227
 
  if (*this_info != NULL) {
228
 
    BFT_FREE((*this_info)->name);
229
 
    BFT_FREE(*this_info);
230
 
  }
231
 
}
232
 
 
233
 
/*----------------------------------------------------------------------------
234
 
 * Output information regarding linear system resolution.
235
 
 *
236
 
 * parameters:
237
 
 *   this_info <-> pointer to linear system info structure
238
 
 *----------------------------------------------------------------------------*/
239
 
 
240
 
static void
241
 
_sles_info_dump(cs_sles_info_t *this_info)
242
 
{
243
 
  int n_calls = this_info->n_calls;
244
 
  int n_it_min = this_info->n_iterations_min;
245
 
  int n_it_max = this_info->n_iterations_max;
246
 
  int n_it_mean = (int)(  this_info->n_iterations_tot
247
 
                        / ((unsigned long long)n_calls));
248
 
 
249
 
  bft_printf(_("\n"
250
 
               "Summary of resolutions for %s (%s):\n"
251
 
               "\n"
252
 
               "  Number of calls:                  %d\n"
253
 
               "  Minimum number of iterations:     %d\n"
254
 
               "  Maximum number of iterations:     %d\n"
255
 
               "  Mean number of iterations:        %d\n"
256
 
               "  Total elapsed time:               %12.3f\n"),
257
 
             this_info->name, cs_sles_type_name[this_info->type],
258
 
             n_calls, n_it_min, n_it_max, n_it_mean,
259
 
             this_info->wt_tot);
260
 
 
261
 
#if defined(HAVE_MPI)
262
 
 
263
 
  if (cs_glob_n_ranks > 1) {
264
 
 
265
 
    double cpu_min, cpu_max, cpu_tot;
266
 
    double cpu_loc = this_info->cpu_tot;
267
 
 
268
 
    MPI_Allreduce(&cpu_loc, &cpu_min, 1, MPI_DOUBLE, MPI_MIN,
269
 
                  cs_glob_mpi_comm);
270
 
    MPI_Allreduce(&cpu_loc, &cpu_max, 1, MPI_DOUBLE, MPI_MAX,
271
 
                  cs_glob_mpi_comm);
272
 
    MPI_Allreduce(&cpu_loc, &cpu_tot, 1, MPI_DOUBLE, MPI_SUM,
273
 
                  cs_glob_mpi_comm);
274
 
 
275
 
    bft_printf(_("  Min local total CPU time:         %12.3f\n"
276
 
                 "  Max local total CPU time:         %12.3f\n"
277
 
                 "  Total CPU time:                   %12.3f\n"),
278
 
               cpu_min, cpu_max, cpu_tot);
279
 
 
280
 
  }
281
 
 
282
 
#endif
283
 
 
284
 
  if (cs_glob_n_ranks == 1)
285
 
    bft_printf(_("  Total CPU time:                   %12.3f\n"),
286
 
               this_info->cpu_tot);
287
 
}
288
 
 
289
 
/*----------------------------------------------------------------------------
290
 
 * Return pointer to linear system info.
291
 
 *
292
 
 * If this system did not previously exist, it is added to the list of
293
 
 * "known" systems.
294
 
 *
295
 
 * parameters:
296
 
 *   name <-- system name
297
 
 *   type <-- resolution method
298
 
 *----------------------------------------------------------------------------*/
299
 
 
300
 
static cs_sles_info_t *
301
 
_find_or_add_system(const char      *name,
302
 
                    cs_sles_type_t   type)
303
 
{
304
 
  int ii, start_id, end_id, mid_id;
305
 
  int cmp_ret = 1;
306
 
 
307
 
  /* Use binary search to find system */
308
 
 
309
 
  start_id = 0;
310
 
  end_id = cs_glob_sles_n_systems - 1;
311
 
  mid_id = start_id + ((end_id -start_id) / 2);
312
 
 
313
 
  while (start_id <= end_id) {
314
 
    cmp_ret = strcmp((cs_glob_sles_systems[mid_id])->name, name);
315
 
    if (cmp_ret == 0)
316
 
      cmp_ret = (cs_glob_sles_systems[mid_id])->type - type;
317
 
    if (cmp_ret < 0)
318
 
      start_id = mid_id + 1;
319
 
    else if (cmp_ret > 0)
320
 
      end_id = mid_id - 1;
321
 
    else
322
 
      break;
323
 
    mid_id = start_id + ((end_id -start_id) / 2);
324
 
  }
325
 
 
326
 
  /* If found, return */
327
 
 
328
 
  if (cmp_ret == 0)
329
 
    return cs_glob_sles_systems[mid_id];
330
 
 
331
 
  /* Reallocate global array if necessary */
332
 
 
333
 
  if (cs_glob_sles_n_systems >= cs_glob_sles_n_max_systems) {
334
 
 
335
 
    if (cs_glob_sles_n_max_systems == 0)
336
 
      cs_glob_sles_n_max_systems = 10;
337
 
    else
338
 
      cs_glob_sles_n_max_systems *= 2;
339
 
    BFT_REALLOC(cs_glob_sles_systems,
340
 
                cs_glob_sles_n_max_systems,
341
 
                cs_sles_info_t*);
342
 
 
343
 
  }
344
 
 
345
 
  /* Insert in sorted list */
346
 
 
347
 
  for (ii = cs_glob_sles_n_systems; ii > mid_id; ii--)
348
 
    cs_glob_sles_systems[ii] = cs_glob_sles_systems[ii - 1];
349
 
 
350
 
  cs_glob_sles_systems[mid_id] = _sles_info_create(name,
351
 
                                                   type);
352
 
  cs_glob_sles_n_systems += 1;
353
 
 
354
 
  return cs_glob_sles_systems[mid_id];
355
 
}
356
 
 
357
 
/*----------------------------------------------------------------------------
358
 
 * Initialize or reset convergence info structure.
359
 
 *
360
 
 * parameters:
361
 
 *   solver_name <-- solver name
362
 
 *   var_name    <-- variable name
363
 
 *   convergence <-> Convergence info structure
364
 
 *   verbosity   <-- Verbosity level
365
 
 *   n_iter_max  <-- Maximum number of iterations
366
 
 *   precision   <-- Precision limit
367
 
 *   r_norm      <-- Residue normalization
368
 
 *   residue     <-- Initial residue
369
 
 *----------------------------------------------------------------------------*/
370
 
 
371
 
static void
372
 
_convergence_init(cs_sles_convergence_t  *convergence,
373
 
                  const char             *solver_name,
374
 
                  const char             *var_name,
375
 
                  int                     verbosity,
376
 
                  unsigned                n_iter_max,
377
 
                  double                  precision,
378
 
                  double                  r_norm,
379
 
                  double                  residue)
380
 
{
381
 
  convergence->verbosity = verbosity;
382
 
 
383
 
  convergence->n_iterations = 0;
384
 
  convergence->n_iterations_max = n_iter_max;
385
 
 
386
 
  convergence->precision = precision;
387
 
  convergence->r_norm = r_norm;
388
 
  convergence->residue = residue;
389
 
  convergence->initial_residue = residue;
390
 
 
391
 
  if (verbosity > 1) {
392
 
    bft_printf("%s [%s]:\n", solver_name, var_name);
393
 
    if (verbosity > 2)
394
 
      bft_printf(_("  n_iter     res_abs     res_nor\n"));
395
 
  }
396
 
 
397
 
}
398
 
 
399
 
/*----------------------------------------------------------------------------
400
 
 * Convergence test.
401
 
 *
402
 
 * parameters:
403
 
 *   solver_name <-- solver name
404
 
 *   var_name    <-- variable name
405
 
 *   n_iter      <-- Number of iterations done
406
 
 *   residue     <-- Non normalized residue
407
 
 *   convergence <-> Convergence information structure
408
 
 *
409
 
 * returns:
410
 
 *   1 if converged, 0 if not converged, -1 if not converged and maximum
411
 
 *   iteration number reached, -2 if divergence is detected.
412
 
 *----------------------------------------------------------------------------*/
413
 
 
414
 
static int
415
 
_convergence_test(const char             *solver_name,
416
 
                  const char             *var_name,
417
 
                  unsigned                n_iter,
418
 
                  double                  residue,
419
 
                  cs_sles_convergence_t  *convergence)
420
 
{
421
 
  const int verbosity = convergence->verbosity;
422
 
 
423
 
  const char final_fmt[]
424
 
    = N_("  n_iter : %5d, res_abs : %11.4e, res_nor : %11.4e\n");
425
 
 
426
 
  /* Update conversion info structure */
427
 
 
428
 
  convergence->n_iterations = n_iter;
429
 
  convergence->residue = residue;
430
 
 
431
 
  /* Print convergence values if high verbosity */
432
 
 
433
 
  if (verbosity > 2)
434
 
    bft_printf("   %5d %11.4e %11.4e\n",
435
 
               n_iter, residue, residue/convergence->r_norm);
436
 
 
437
 
  /* If not converged */
438
 
 
439
 
  if (residue > convergence->precision * convergence->r_norm) {
440
 
 
441
 
    if (n_iter < convergence->n_iterations_max) {
442
 
      int diverges = 0;
443
 
      if (residue > convergence->initial_residue * 10000.0 && residue > 100.)
444
 
        diverges = 1;
445
 
#if (_CS_STDC_VERSION >= 199901L)
446
 
      else if (isnan(residue) || isinf(residue))
447
 
        diverges = 1;
448
 
#endif
449
 
      if (diverges) {
450
 
        bft_printf(_("\n\n"
451
 
                     "%s [%s]: divergence after %u iterations:\n"
452
 
                     "  initial residual: %11.4e; current residual: %11.4e\n"),
453
 
                   solver_name, var_name,
454
 
                   convergence->n_iterations,
455
 
                   convergence->initial_residue, convergence->residue);
456
 
        return -2;
457
 
      }
458
 
      else
459
 
        return 0;
460
 
    }
461
 
    else {
462
 
      if (verbosity > 0) {
463
 
        if (verbosity == 1) /* Already output if verbosity > 1 */
464
 
          bft_printf("%s [%s]:\n", solver_name, var_name);
465
 
        if (verbosity <= 2) /* Already output if verbosity > 2 */
466
 
          bft_printf(_(final_fmt),
467
 
                     n_iter, residue, residue/convergence->r_norm);
468
 
        bft_printf(_(" @@ Warning: non convergence\n"));
469
 
      }
470
 
      return -1;
471
 
    }
472
 
 
473
 
  }
474
 
 
475
 
  /* If converged */
476
 
 
477
 
  else {
478
 
    if (verbosity == 2) /* Already output if verbosity > 2 */
479
 
      bft_printf(final_fmt, n_iter, residue, residue/convergence->r_norm);
480
 
    return 1;
481
 
  }
482
 
 
483
 
}
484
 
 
485
 
/*----------------------------------------------------------------------------
486
 
 * Compute dot product, summing result over all ranks.
487
 
 *
488
 
 * parameters:
489
 
 *   n_elts <-- Local number of elements
490
 
 *   x      <-- first vector in s = x.y
491
 
 *   y      <-- second vector in s = x.y
492
 
 *
493
 
 * returns:
494
 
 *   result of s = x.y
495
 
 *----------------------------------------------------------------------------*/
496
 
 
497
 
inline static double
498
 
_dot_product(cs_int_t          n_elts,
499
 
             const cs_real_t  *x,
500
 
             const cs_real_t  *y)
501
 
{
502
 
  double s = cblas_ddot(n_elts, x, 1, y, 1);
503
 
 
504
 
#if defined(HAVE_MPI)
505
 
 
506
 
  if (cs_glob_n_ranks > 1) {
507
 
    double _sum;
508
 
    MPI_Allreduce(&s, &_sum, 1, MPI_DOUBLE, MPI_SUM, cs_glob_mpi_comm);
509
 
    s = _sum;
510
 
  }
511
 
 
512
 
#endif /* defined(HAVE_MPI) */
513
 
 
514
 
  return s;
515
 
}
516
 
 
517
 
/*----------------------------------------------------------------------------
518
 
 * Compute 2 dot products, summing result over all ranks.
519
 
 *
520
 
 * parameters:
521
 
 *   n_elts <-- Local number of elements
522
 
 *   x1     <-- first vector in s1 = x1.y1
523
 
 *   y1     <-- second vector in s1 = x1.y1
524
 
 *   x2     <-- first vector in s2 = x2.y2
525
 
 *   y2     <-- second vector in s2 = x2.y2
526
 
 *   s1     --> result of s1 = x1.y1
527
 
 *   s2     --> result of s2 = x2.y2
528
 
 *----------------------------------------------------------------------------*/
529
 
 
530
 
inline static void
531
 
_dot_products_2(cs_int_t          n_elts,
532
 
                const cs_real_t  *x1,
533
 
                const cs_real_t  *y1,
534
 
                const cs_real_t  *x2,
535
 
                const cs_real_t  *y2,
536
 
                double           *s1,
537
 
                double           *s2)
538
 
{
539
 
  cs_int_t ii;
540
 
  double s[2];
541
 
 
542
 
  /* If a term appears in both dot products, we do not use the BLAS,
543
 
     as grouping both dot products in a same loop allows for better
544
 
     cache use and often better performance than separate dot products
545
 
     with even optimized BLAS */
546
 
 
547
 
  if (x1 == x2 || x1 == y2 || y1 == x2 || y1 == y2) {
548
 
 
549
 
    /* Use temporary variables to help some compilers optimize */
550
 
    double _s0 = 0.0, _s1 = 0.0;
551
 
    for (ii = 0; ii < n_elts; ii++) {
552
 
      _s0 += x1[ii] * y1[ii];
553
 
      _s1 += x2[ii] * y2[ii];
554
 
    }
555
 
    s[0] = _s0; s[1] = _s1;
556
 
 
557
 
  }
558
 
  else {
559
 
 
560
 
    s[0] = cblas_ddot(n_elts, x1, 1, y1, 1);
561
 
    s[1] = cblas_ddot(n_elts, x2, 1, y2, 1);
562
 
 
563
 
  }
564
 
 
565
 
#if defined(HAVE_MPI)
566
 
 
567
 
  if (cs_glob_n_ranks > 1) {
568
 
    double _sum[2];
569
 
    MPI_Allreduce(s, _sum, 2, MPI_DOUBLE, MPI_SUM, cs_glob_mpi_comm);
570
 
    s[0] = _sum[0];
571
 
    s[1] = _sum[1];
572
 
  }
573
 
 
574
 
#endif /* defined(HAVE_MPI) */
575
 
 
576
 
  *s1 = s[0];
577
 
  *s2 = s[1];
578
 
}
579
 
 
580
 
/*----------------------------------------------------------------------------
581
 
 * Compute y <- x + alpha.y
582
 
 *
583
 
 * parameters:
584
 
 *   n     <-- Number of elements in vectors x, y, z
585
 
 *   alpha <-- Scalar alpha
586
 
 *   x     <-- Vector x (size: n)
587
 
 *   y     <-> Vector y (size: n)
588
 
 *----------------------------------------------------------------------------*/
589
 
 
590
 
inline static void
591
 
_y_aypx(cs_int_t    n,
592
 
        cs_real_t   alpha,
593
 
        cs_real_t  *restrict x,
594
 
        cs_real_t  *restrict y)
595
 
{
596
 
#if defined(HAVE_ESSL)
597
 
 
598
 
  dzaxpy(n, alpha, y, 1, x, 1, y, 1);
599
 
 
600
 
#else
601
 
 
602
 
 {
603
 
   cs_int_t ii;
604
 
 
605
 
#if defined(__xlc__)
606
 
#pragma disjoint(alpha, *x, *y)
607
 
#endif
608
 
 
609
 
   for (ii = 0; ii < n; ii++)
610
 
     y[ii] = x[ii] + (alpha * y[ii]);
611
 
 }
612
 
 
613
 
#endif
614
 
 
615
 
}
616
 
 
617
 
/*----------------------------------------------------------------------------
618
 
 * Residue preconditioning Gk = C.Rk
619
 
 *
620
 
 * To increase the polynomial order with no major overhead, we may
621
 
 * "implicit" the resolution using a red-black mesh coloring.
622
 
 *
623
 
 * poly_degree:
624
 
 *   0: Gk = (1/ad).Rk
625
 
 *   1: Gk = (1/ad - (1/ad).ax.(1/ad)).Rk
626
 
 *   2: Gk = (1/ad - (1/ad).ax.(1/ad) + (1/ad).ax.(1/ad).ax.(1/ad)).Rk
627
 
 *
628
 
 * parameters:
629
 
 *   n_cells       <--  Local number of cells
630
 
 *   poly_degree   <--  preconditioning polynomial degree (0: diagonal)
631
 
 *   rotation_mode <--  Halo update option for rotational periodicity
632
 
 *   ad_inv        <--  Inverse of matrix diagonal
633
 
 *   ax            <--  Non-diagonal part of linear equation matrix
634
 
 *   rk            <--  Residue vector
635
 
 *   gk            -->  Result vector
636
 
 *   wk            ---  Working array
637
 
 *----------------------------------------------------------------------------*/
638
 
 
639
 
static void
640
 
_polynomial_preconditionning(cs_int_t            n_cells,
641
 
                             int                 poly_degree,
642
 
                             cs_perio_rota_t     rotation_mode,
643
 
                             const cs_real_t    *ad_inv,
644
 
                             const cs_matrix_t  *ax,
645
 
                             const cs_real_t    *rk,
646
 
                             cs_real_t          *restrict gk,
647
 
                             cs_real_t          *restrict wk)
648
 
{
649
 
  int deg_id;
650
 
  cs_int_t ii;
651
 
 
652
 
#if defined(__xlc__)
653
 
#pragma disjoint(*ad_inv, *rk, *gk, *wk)
654
 
#endif
655
 
 
656
 
  /* Polynomial of degree 0 (diagonal)
657
 
   *-----------------------------------*/
658
 
 
659
 
  for (ii = 0; ii < n_cells; ii++)
660
 
    gk[ii] = rk[ii] * ad_inv[ii];
661
 
 
662
 
  /* Polynomial of degree n
663
 
   *-----------------------
664
 
   *
665
 
   *                  n=1                    n=2
666
 
   * gk = ((1/ad) - (1/ad).ax.(1/ad) + (1/ad).ax.(1/ad).ax.(1/ad) + ... ).rk
667
 
   */
668
 
 
669
 
  for (deg_id = 1; deg_id <= poly_degree; deg_id++) {
670
 
 
671
 
    /* Compute Wk = (A-diag).Gk */
672
 
 
673
 
    cs_matrix_vector_multiply(rotation_mode, ax, gk, wk);
674
 
 
675
 
    for (ii = 0; ii < n_cells; ii++)
676
 
      gk[ii] = (rk[ii] - wk[ii]) * ad_inv[ii];
677
 
 
678
 
  }
679
 
 
680
 
}
681
 
 
682
 
/*----------------------------------------------------------------------------
683
 
 * Solution of (ad+ax).vx = Rhs using preconditioned conjugate gradient.
684
 
 *
685
 
 * Single-processor-optimized version.
686
 
 *
687
 
 * On entry, vx is considered initialized.
688
 
 *
689
 
 * parameters:
690
 
 *   var_name      <-- Variable name
691
 
 *   a             <-- Matrix
692
 
 *   ax            <-- Non-diagonal part of linear equation matrix
693
 
 *                     (only necessary if poly_degree > 0)
694
 
 *   poly_degree   <-- Preconditioning polynomial degree (0: diagonal)
695
 
 *   rotation_mode <-- Halo update option for rotational periodicity
696
 
 *   convergence   <-- Convergence information structure
697
 
 *   rhs           <-- Right hand side
698
 
 *   vx            --> System solution
699
 
 *   aux_size      <-- Number of elements in aux_vectors
700
 
 *   aux_vectors   --- Optional working area (allocation otherwise)
701
 
 *
702
 
 * returns:
703
 
 *   1 if converged, 0 if not converged, -1 if not converged and maximum
704
 
 *   iteration number reached, -2 if divergence is detected.
705
 
 *----------------------------------------------------------------------------*/
706
 
 
707
 
static int
708
 
_conjugate_gradient_sp(const char             *var_name,
709
 
                       const cs_matrix_t      *a,
710
 
                       const cs_matrix_t      *ax,
711
 
                       int                     poly_degree,
712
 
                       cs_perio_rota_t         rotation_mode,
713
 
                       cs_sles_convergence_t  *convergence,
714
 
                       const cs_real_t        *rhs,
715
 
                       cs_real_t              *restrict vx,
716
 
                       size_t                  aux_size,
717
 
                       void                   *aux_vectors)
718
 
{
719
 
  const char *sles_name;
720
 
  int cvg;
721
 
  cs_int_t  n_cols, n_rows, ii;
722
 
  double  ro_0, ro_1, alpha, rk_gkm1, rk_gk, beta, residue;
723
 
  cs_real_t  *_aux_vectors;
724
 
  cs_real_t  *restrict rk, *restrict dk, *restrict gk;
725
 
  cs_real_t *restrict zk, *restrict wk, *restrict ad_inv;
726
 
 
727
 
  unsigned n_iter = 1;
728
 
 
729
 
  /* Tell IBM compiler not to alias */
730
 
#if defined(__xlc__)
731
 
#pragma disjoint(*rhs, *vx, *rk, *dk, *gk, *zk, *wk, *ad_inv)
732
 
#endif
733
 
 
734
 
  /* Preliminary calculations */
735
 
  /*--------------------------*/
736
 
 
737
 
  sles_name = _(cs_sles_type_name[CS_SLES_PCG]);
738
 
 
739
 
  n_cols = cs_matrix_get_n_columns(a);
740
 
  n_rows = cs_matrix_get_n_rows(a);
741
 
 
742
 
  /* Allocate work arrays */
743
 
 
744
 
  {
745
 
    size_t  n_wa = 5;
746
 
    size_t  wa_size = n_cols;
747
 
 
748
 
    if (poly_degree > 0)
749
 
      n_wa += 1;
750
 
 
751
 
    if (aux_vectors == NULL || aux_size < (wa_size * n_wa))
752
 
      BFT_MALLOC(_aux_vectors, wa_size * n_wa, cs_real_t);
753
 
    else
754
 
      _aux_vectors = aux_vectors;
755
 
 
756
 
    ad_inv = _aux_vectors;
757
 
 
758
 
    rk = _aux_vectors + wa_size;
759
 
    dk = _aux_vectors + wa_size*2;
760
 
    gk = _aux_vectors + wa_size*3;
761
 
    zk = _aux_vectors + wa_size*4;
762
 
 
763
 
    if (poly_degree > 0)
764
 
      wk = _aux_vectors + wa_size*5;
765
 
    else
766
 
      wk = NULL;
767
 
  }
768
 
 
769
 
  cs_matrix_get_diagonal(a, ad_inv);
770
 
  for (ii = 0; ii < n_rows; ii++)
771
 
    ad_inv[ii] = 1.0 / ad_inv[ii];
772
 
 
773
 
  /* Initialize work arrays (not necessary, just for debugging) */
774
 
 
775
 
  for (ii = 0; ii < n_rows; ii++) {
776
 
    rk[ii] = 0.0;
777
 
    dk[ii] = 0.0;
778
 
    gk[ii] = 0.0;
779
 
    zk[ii] = 0.0;
780
 
  }
781
 
 
782
 
  /* Initialize iterative calculation */
783
 
  /*----------------------------------*/
784
 
 
785
 
  /* Residue and descent direction */
786
 
 
787
 
  cs_matrix_vector_multiply(rotation_mode, a, vx, rk);
788
 
 
789
 
  for (ii = 0; ii < n_rows; ii++) {
790
 
    rk[ii] = rk[ii] - rhs[ii];
791
 
    dk[ii] = rk[ii];
792
 
  }
793
 
 
794
 
  /* Polynomial preconditionning of order poly_degre */
795
 
 
796
 
  _polynomial_preconditionning(n_rows,
797
 
                               poly_degree,
798
 
                               rotation_mode,
799
 
                               ad_inv,
800
 
                               ax,
801
 
                               rk,
802
 
                               gk,
803
 
                               wk);
804
 
 
805
 
  /* Descent direction */
806
 
  /*-------------------*/
807
 
 
808
 
  memcpy(dk, gk, n_rows * sizeof(cs_real_t));
809
 
 
810
 
  rk_gkm1 = _dot_product(n_rows, rk, gk);
811
 
 
812
 
  cs_matrix_vector_multiply(rotation_mode, a, dk, zk);
813
 
 
814
 
  /* Descent parameter */
815
 
 
816
 
  _dot_products_2(n_rows, rk, dk, dk, zk, &ro_0, &ro_1);
817
 
 
818
 
  alpha =  - ro_0 / ro_1;
819
 
 
820
 
  cblas_daxpy(n_rows, alpha, dk, 1, vx, 1);
821
 
  cblas_daxpy(n_rows, alpha, zk, 1, rk, 1);
822
 
 
823
 
  /* Convergence test */
824
 
 
825
 
  residue = sqrt(_dot_product(n_rows, rk, rk));
826
 
 
827
 
  cvg = _convergence_test(sles_name, var_name,
828
 
                          n_iter, residue, convergence);
829
 
 
830
 
  /* Current Iteration */
831
 
  /*-------------------*/
832
 
 
833
 
  while (cvg == 0) {
834
 
 
835
 
    n_iter += 1;
836
 
 
837
 
    _polynomial_preconditionning(n_rows,
838
 
                                 poly_degree,
839
 
                                 rotation_mode,
840
 
                                 ad_inv,
841
 
                                 ax,
842
 
                                 rk,
843
 
                                 gk,
844
 
                                 wk);
845
 
 
846
 
    /* Descent parameter */
847
 
 
848
 
    rk_gk = _dot_product(n_rows, rk, gk);
849
 
 
850
 
    /* Complete descent parameter computation and matrix.vector product */
851
 
 
852
 
    beta = rk_gk / rk_gkm1;
853
 
    rk_gkm1 = rk_gk;
854
 
 
855
 
    _y_aypx(n_rows, beta, gk, dk);  /* dk <- gk + (beta.dk) */
856
 
 
857
 
    cs_matrix_vector_multiply(rotation_mode, a, dk, zk);
858
 
 
859
 
    _dot_products_2(n_rows, rk, dk, dk, zk, &ro_0, &ro_1);
860
 
 
861
 
    alpha =  - ro_0 / ro_1;
862
 
 
863
 
    cblas_daxpy(n_rows, alpha, dk, 1, vx, 1);
864
 
    cblas_daxpy(n_rows, alpha, zk, 1, rk, 1);
865
 
 
866
 
    /* Convergence test */
867
 
 
868
 
    residue = sqrt(_dot_product(n_rows, rk, rk));
869
 
 
870
 
    cvg = _convergence_test(sles_name, var_name,
871
 
                            n_iter, residue, convergence);
872
 
 
873
 
  }
874
 
 
875
 
  if (_aux_vectors != aux_vectors)
876
 
    BFT_FREE(_aux_vectors);
877
 
 
878
 
  return cvg;
879
 
}
880
 
 
881
 
/*----------------------------------------------------------------------------
882
 
 * Solution of (ad+ax).vx = Rhs using preconditioned conjugate gradient.
883
 
 *
884
 
 * Parallel-optimized version, groups dot products, at the cost of
885
 
 * computation of the preconditionning for n+1 iterations instead of n.
886
 
 *
887
 
 * On entry, vx is considered initialized.
888
 
 *
889
 
 * parameters:
890
 
 *   var_name      <-- Variable name
891
 
 *   a             <-- Matrix
892
 
 *   ax            <-- Non-diagonal part of linear equation matrix
893
 
 *                     (only necessary if poly_degree > 0)
894
 
 *   poly_degree   <-- Preconditioning polynomial degree (0: diagonal)
895
 
 *   rotation_mode <-- Halo update option for rotational periodicity
896
 
 *   convergence   <-- Convergence information structure
897
 
 *   rhs           <-- Right hand side
898
 
 *   vx            --> System solution
899
 
 *   aux_size      <-- Number of elements in aux_vectors
900
 
 *   aux_vectors   --- Optional working area (allocation otherwise)
901
 
 *
902
 
 * returns:
903
 
 *   1 if converged, 0 if not converged, -1 if not converged and maximum
904
 
 *   iteration number reached, -2 if divergence is detected.
905
 
 *----------------------------------------------------------------------------*/
906
 
 
907
 
static int
908
 
_conjugate_gradient_mp(const char             *var_name,
909
 
                       const cs_matrix_t      *a,
910
 
                       const cs_matrix_t      *ax,
911
 
                       int                     poly_degree,
912
 
                       cs_perio_rota_t         rotation_mode,
913
 
                       cs_sles_convergence_t  *convergence,
914
 
                       const cs_real_t        *rhs,
915
 
                       cs_real_t              *restrict vx,
916
 
                       size_t                  aux_size,
917
 
                       void                   *aux_vectors)
918
 
{
919
 
  const char *sles_name;
920
 
  int cvg;
921
 
  cs_int_t  n_cols, n_rows, ii;
922
 
  double  ro_0, ro_1, alpha, rk_gkm1, rk_gk, beta, residue;
923
 
  cs_real_t  *_aux_vectors;
924
 
  cs_real_t  *restrict rk, *restrict dk, *restrict gk;
925
 
  cs_real_t *restrict zk, *restrict wk, *restrict ad_inv;
926
 
 
927
 
  unsigned n_iter = 1;
928
 
 
929
 
  /* Tell IBM compiler not to alias */
930
 
#if defined(__xlc__)
931
 
#pragma disjoint(*rhs, *vx, *rk, *dk, *gk, *zk, *wk, *ad_inv)
932
 
#endif
933
 
 
934
 
  /* Preliminary calculations */
935
 
  /*--------------------------*/
936
 
 
937
 
  sles_name = _(cs_sles_type_name[CS_SLES_PCG]);
938
 
 
939
 
  n_cols = cs_matrix_get_n_columns(a);
940
 
  n_rows = cs_matrix_get_n_rows(a);
941
 
 
942
 
  /* Allocate work arrays */
943
 
 
944
 
  {
945
 
    size_t  n_wa = 5;
946
 
    size_t  wa_size = n_cols;
947
 
 
948
 
    if (poly_degree > 0)
949
 
      n_wa += 1;
950
 
 
951
 
    if (aux_vectors == NULL || aux_size < (wa_size * n_wa))
952
 
      BFT_MALLOC(_aux_vectors, wa_size * n_wa, cs_real_t);
953
 
    else
954
 
      _aux_vectors = aux_vectors;
955
 
 
956
 
    ad_inv = _aux_vectors;
957
 
 
958
 
    rk = _aux_vectors + wa_size;
959
 
    dk = _aux_vectors + wa_size*2;
960
 
    gk = _aux_vectors + wa_size*3;
961
 
    zk = _aux_vectors + wa_size*4;
962
 
 
963
 
    if (poly_degree > 0)
964
 
      wk = _aux_vectors + wa_size*5;
965
 
    else
966
 
      wk = NULL;
967
 
  }
968
 
 
969
 
  cs_matrix_get_diagonal(a, ad_inv);
970
 
  for (ii = 0; ii < n_rows; ii++)
971
 
    ad_inv[ii] = 1.0 / ad_inv[ii];
972
 
 
973
 
  /* Initialize work arrays (not necessary, just for debugging) */
974
 
 
975
 
  for (ii = 0; ii < n_rows; ii++) {
976
 
    rk[ii] = 0.0;
977
 
    dk[ii] = 0.0;
978
 
    gk[ii] = 0.0;
979
 
    zk[ii] = 0.0;
980
 
  }
981
 
 
982
 
  /* Initialize iterative calculation */
983
 
  /*----------------------------------*/
984
 
 
985
 
  /* Residue and descent direction */
986
 
 
987
 
  cs_matrix_vector_multiply(rotation_mode, a, vx, rk);
988
 
 
989
 
  for (ii = 0; ii < n_rows; ii++) {
990
 
    rk[ii] = rk[ii] - rhs[ii];
991
 
    dk[ii] = rk[ii];
992
 
  }
993
 
 
994
 
  /* Polynomial preconditionning of order poly_degre */
995
 
 
996
 
  _polynomial_preconditionning(n_rows,
997
 
                               poly_degree,
998
 
                               rotation_mode,
999
 
                               ad_inv,
1000
 
                               ax,
1001
 
                               rk,
1002
 
                               gk,
1003
 
                               wk);
1004
 
 
1005
 
  /* Descent direction */
1006
 
  /*-------------------*/
1007
 
 
1008
 
  memcpy(dk, gk, n_rows * sizeof(cs_real_t));
1009
 
 
1010
 
  rk_gkm1 = _dot_product(n_rows, rk, gk);
1011
 
 
1012
 
  cs_matrix_vector_multiply(rotation_mode, a, dk, zk);
1013
 
 
1014
 
  /* Descent parameter */
1015
 
 
1016
 
  _dot_products_2(n_rows, rk, dk, dk, zk, &ro_0, &ro_1);
1017
 
 
1018
 
  alpha =  - ro_0 / ro_1;
1019
 
 
1020
 
  cblas_daxpy(n_rows, alpha, dk, 1, vx, 1);
1021
 
  cblas_daxpy(n_rows, alpha, zk, 1, rk, 1);
1022
 
 
1023
 
  /* Convergence test */
1024
 
 
1025
 
  residue = sqrt(_dot_product(n_rows, rk, rk));
1026
 
 
1027
 
  cvg = _convergence_test(sles_name, var_name,
1028
 
                          n_iter, residue, convergence);
1029
 
 
1030
 
  /* Current Iteration */
1031
 
  /*-------------------*/
1032
 
 
1033
 
  while (cvg == 0) {
1034
 
 
1035
 
    _polynomial_preconditionning(n_rows,
1036
 
                                 poly_degree,
1037
 
                                 rotation_mode,
1038
 
                                 ad_inv,
1039
 
                                 ax,
1040
 
                                 rk,
1041
 
                                 gk,
1042
 
                                 wk);
1043
 
 
1044
 
    /* compute residue and prepare descent parameter */
1045
 
 
1046
 
    _dot_products_2(n_rows, rk, rk, rk, gk, &residue, &rk_gk);
1047
 
 
1048
 
    residue = sqrt(residue);
1049
 
 
1050
 
    /* Convergence test for end of previous iteration */
1051
 
 
1052
 
    if (n_iter > 1)
1053
 
      cvg = _convergence_test(sles_name, var_name,
1054
 
                              n_iter, residue, convergence);
1055
 
 
1056
 
    if (cvg != 0)
1057
 
      break;
1058
 
 
1059
 
    n_iter += 1;
1060
 
 
1061
 
    /* Complete descent parameter computation and matrix.vector product */
1062
 
 
1063
 
    beta = rk_gk / rk_gkm1;
1064
 
    rk_gkm1 = rk_gk;
1065
 
 
1066
 
    _y_aypx(n_rows, beta, gk, dk);  /* dk <- gk + (beta.dk) */
1067
 
 
1068
 
    cs_matrix_vector_multiply(rotation_mode, a, dk, zk);
1069
 
 
1070
 
    _dot_products_2(n_rows, rk, dk, dk, zk, &ro_0, &ro_1);
1071
 
 
1072
 
    alpha =  - ro_0 / ro_1;
1073
 
 
1074
 
    cblas_daxpy(n_rows, alpha, dk, 1, vx, 1);
1075
 
    cblas_daxpy(n_rows, alpha, zk, 1, rk, 1);
1076
 
 
1077
 
  }
1078
 
 
1079
 
  if (_aux_vectors != aux_vectors)
1080
 
    BFT_FREE(_aux_vectors);
1081
 
 
1082
 
  return cvg;
1083
 
}
1084
 
 
1085
 
/*----------------------------------------------------------------------------
1086
 
 * Solution of (ad+ax).vx = Rhs using Jacobi.
1087
 
 *
1088
 
 * On entry, vx is considered initialized.
1089
 
 *
1090
 
 * parameters:
1091
 
 *   var_name      <-- Variable name
1092
 
 *   ad            <-- Diagonal part of linear equation matrix
1093
 
 *   ax            <-- Non-diagonal part of linear equation matrix
1094
 
 *   rotation_mode <-- Halo update option for rotational periodicity
1095
 
 *   convergence   <-- Convergence information structure
1096
 
 *   rhs           <-- Right hand side
1097
 
 *   vx            --> System solution
1098
 
 *   aux_size      <-- Number of elements in aux_vectors
1099
 
 *   aux_vectors   --- Optional working area (allocation otherwise)
1100
 
 *
1101
 
 * returns:
1102
 
 *   1 if converged, 0 if not converged, -1 if not converged and maximum
1103
 
 *   iteration number reached, -2 if divergence is detected.
1104
 
 *----------------------------------------------------------------------------*/
1105
 
 
1106
 
static int
1107
 
_jacobi(const char             *var_name,
1108
 
        const cs_real_t        *restrict ad,
1109
 
        const cs_matrix_t      *ax,
1110
 
        cs_perio_rota_t         rotation_mode,
1111
 
        cs_sles_convergence_t  *convergence,
1112
 
        const cs_real_t        *rhs,
1113
 
        cs_real_t              *restrict vx,
1114
 
        size_t                  aux_size,
1115
 
        void                   *aux_vectors)
1116
 
{
1117
 
  const char *sles_name;
1118
 
  int cvg;
1119
 
  cs_int_t  n_cols, n_rows, ii;
1120
 
  double  res2, residue;
1121
 
  cs_real_t  *_aux_vectors;
1122
 
  cs_real_t  *restrict ad_inv, *restrict rk;
1123
 
 
1124
 
  unsigned n_iter = 0;
1125
 
 
1126
 
  /* Tell IBM compiler not to alias */
1127
 
#if defined(__xlc__)
1128
 
#pragma disjoint(*rhs, *vx, *ad, *ad_inv)
1129
 
#endif
1130
 
 
1131
 
  /* Preliminary calculations */
1132
 
  /*--------------------------*/
1133
 
 
1134
 
  sles_name = _(cs_sles_type_name[CS_SLES_JACOBI]);
1135
 
 
1136
 
  n_cols = cs_matrix_get_n_columns(ax);
1137
 
  n_rows = cs_matrix_get_n_rows(ax);
1138
 
 
1139
 
  /* Allocate work arrays */
1140
 
 
1141
 
  {
1142
 
    size_t  wa_size = n_cols;
1143
 
 
1144
 
    if (aux_vectors == NULL || aux_size < (wa_size * 2))
1145
 
      BFT_MALLOC(_aux_vectors, wa_size * 2, cs_real_t);
1146
 
    else
1147
 
      _aux_vectors = aux_vectors;
1148
 
 
1149
 
    ad_inv = _aux_vectors;
1150
 
    rk     = _aux_vectors + wa_size;
1151
 
  }
1152
 
 
1153
 
  for (ii = 0; ii < n_rows; ii++)
1154
 
    ad_inv[ii] = 1.0 / ad[ii];
1155
 
 
1156
 
  cvg = 0;
1157
 
 
1158
 
  /* Current iteration */
1159
 
  /*-------------------*/
1160
 
 
1161
 
  while (cvg == 0) {
1162
 
 
1163
 
    n_iter += 1;
1164
 
 
1165
 
    memcpy(rk, vx, n_rows * sizeof(cs_real_t));  /* rk <- vx */
1166
 
 
1167
 
    memcpy(vx, rhs, n_rows * sizeof(cs_real_t));  /* vx <- rhs */
1168
 
    for (ii = n_rows; ii < n_cols; ii++)
1169
 
      vx[ii] = 0.0;
1170
 
 
1171
 
    /* Compute Vx <- Vx - (A-diag).Rk */
1172
 
 
1173
 
    cs_matrix_alpha_a_x_p_beta_y(rotation_mode, -1.0, 1.0, ax, rk, vx);
1174
 
 
1175
 
    for (ii = 0; ii < n_rows; ii++)
1176
 
      vx[ii] = vx[ii] * ad_inv[ii];
1177
 
 
1178
 
    /* Compute residue */
1179
 
 
1180
 
    res2 = 0.0;
1181
 
 
1182
 
    for (ii = 0; ii < n_rows; ii++) {
1183
 
      register double r = ad[ii] * (vx[ii]-rk[ii]);
1184
 
      res2 += (r*r);
1185
 
    }
1186
 
 
1187
 
#if defined(HAVE_MPI)
1188
 
 
1189
 
    if (cs_glob_n_ranks > 1) {
1190
 
      double _sum;
1191
 
      MPI_Allreduce(&res2, &_sum, 1, MPI_DOUBLE, MPI_SUM,
1192
 
                    cs_glob_mpi_comm);
1193
 
      res2 = _sum;
1194
 
    }
1195
 
 
1196
 
#endif /* defined(HAVE_MPI) */
1197
 
 
1198
 
    residue = sqrt(res2);
1199
 
 
1200
 
    /* Convergence test */
1201
 
 
1202
 
    cvg = _convergence_test(sles_name, var_name,
1203
 
                            n_iter, residue, convergence);
1204
 
 
1205
 
  }
1206
 
 
1207
 
  if (_aux_vectors != aux_vectors)
1208
 
    BFT_FREE(_aux_vectors);
1209
 
 
1210
 
  return cvg;
1211
 
}
1212
 
 
1213
 
/*----------------------------------------------------------------------------
1214
 
 * Solution of (ad+ax).vx = Rhs using preconditioned Bi-CGSTAB.
1215
 
 *
1216
 
 * Parallel-optimized version, groups dot products, at the cost of
1217
 
 * computation of the preconditionning for n+1 iterations instead of n.
1218
 
 *
1219
 
 * On entry, vx is considered initialized.
1220
 
 *
1221
 
 * parameters:
1222
 
 *   var_name      <-- Variable name
1223
 
 *   a             <-- Matrix
1224
 
 *   ax            <-- Non-diagonal part of linear equation matrix
1225
 
 *                     (only necessary if poly_degree > 0)
1226
 
 *   poly_degree   <-- Preconditioning polynomial degree (0: diagonal)
1227
 
 *   rotation_mode <-- Halo update option for rotational periodicity
1228
 
 *   convergence   <-- Convergence information structure
1229
 
 *   rhs           <-- Right hand side
1230
 
 *   vx            --> System solution
1231
 
 *   aux_size      <-- Number of elements in aux_vectors
1232
 
 *   aux_vectors   --- Optional working area (allocation otherwise)
1233
 
 *
1234
 
 * returns:
1235
 
 *   1 if converged, 0 if not converged, -1 if not converged and maximum
1236
 
 *   iteration number reached, -2 if divergence is detected.
1237
 
 *----------------------------------------------------------------------------*/
1238
 
 
1239
 
static int
1240
 
_bi_cgstab(const char             *var_name,
1241
 
           const cs_matrix_t      *a,
1242
 
           const cs_matrix_t      *ax,
1243
 
           int                     poly_degree,
1244
 
           cs_perio_rota_t         rotation_mode,
1245
 
           cs_sles_convergence_t  *convergence,
1246
 
           const cs_real_t        *rhs,
1247
 
           cs_real_t              *restrict vx,
1248
 
           size_t                  aux_size,
1249
 
           void                   *aux_vectors)
1250
 
{
1251
 
  const char *sles_name;
1252
 
  int cvg;
1253
 
  cs_int_t  n_cols, n_rows, ii;
1254
 
  double  _epzero = 1.e-30; /* smaller than epzero */
1255
 
  double  ro_0, ro_1, alpha, beta, betam1, gamma, omega, ukres0;
1256
 
  double  residue;
1257
 
  cs_real_t  *_aux_vectors;
1258
 
  cs_real_t  *restrict res0, *restrict rk, *restrict pk, *restrict zk;
1259
 
  cs_real_t  *restrict uk, *restrict vk, *restrict ad_inv;
1260
 
 
1261
 
  unsigned n_iter = 0;
1262
 
 
1263
 
  /* Tell IBM compiler not to alias */
1264
 
#if defined(__xlc__)
1265
 
#pragma disjoint(*rhs, *vx, *res0, *rk, *pk, *zk, *uk, *vk, *ad_inv)
1266
 
#endif
1267
 
 
1268
 
  /* Preliminary calculations */
1269
 
  /*--------------------------*/
1270
 
 
1271
 
  sles_name = _(cs_sles_type_name[CS_SLES_BICGSTAB]);
1272
 
 
1273
 
  n_cols = cs_matrix_get_n_columns(a);
1274
 
  n_rows = cs_matrix_get_n_rows(a);
1275
 
 
1276
 
  /* Allocate work arrays */
1277
 
 
1278
 
  {
1279
 
    size_t  n_wa = 7;
1280
 
    size_t  wa_size = n_cols;
1281
 
 
1282
 
    if (aux_vectors == NULL || aux_size < (wa_size * n_wa))
1283
 
      BFT_MALLOC(_aux_vectors, wa_size * n_wa, cs_real_t);
1284
 
    else
1285
 
      _aux_vectors = aux_vectors;
1286
 
 
1287
 
    ad_inv = _aux_vectors;
1288
 
 
1289
 
    res0 = _aux_vectors + wa_size;
1290
 
    rk = _aux_vectors + wa_size*2;
1291
 
    pk = _aux_vectors + wa_size*3;
1292
 
    zk = _aux_vectors + wa_size*4;
1293
 
    uk = _aux_vectors + wa_size*5;
1294
 
    vk = _aux_vectors + wa_size*6;
1295
 
 
1296
 
  }
1297
 
 
1298
 
  cs_matrix_get_diagonal(a, ad_inv);
1299
 
  for (ii = 0; ii < n_rows; ii++)
1300
 
    ad_inv[ii] = 1.0 / ad_inv[ii];
1301
 
 
1302
 
  /* Initialize work arrays (not necessary, just for debugging) */
1303
 
 
1304
 
  for (ii = 0; ii < n_rows; ii++) {
1305
 
    res0[ii] = 0.0;
1306
 
    rk[ii] = 0.0;
1307
 
    pk[ii] = 0.0;
1308
 
    zk[ii] = 0.0;
1309
 
    uk[ii] = 0.0;
1310
 
    vk[ii] = 0.0;
1311
 
  }
1312
 
 
1313
 
  /* Initialize iterative calculation */
1314
 
  /*----------------------------------*/
1315
 
 
1316
 
  cs_matrix_vector_multiply(rotation_mode, a, vx, res0);
1317
 
 
1318
 
  for (ii = 0; ii < n_rows; ii++) {
1319
 
    res0[ii] = -res0[ii] + rhs[ii];
1320
 
    rk[ii] = res0[ii];
1321
 
  }
1322
 
 
1323
 
  alpha = 1.0;
1324
 
  betam1 = 1.0;
1325
 
  gamma = 1.0;
1326
 
 
1327
 
  cvg = 0;
1328
 
 
1329
 
  /* Current Iteration */
1330
 
  /*-------------------*/
1331
 
 
1332
 
  while (cvg == 0) {
1333
 
 
1334
 
    /* Compute beta and omega;
1335
 
       group dot products for new iteration's beta
1336
 
       and previous iteration's residue to reduce total latency */
1337
 
 
1338
 
    if (n_iter == 0) {
1339
 
 
1340
 
      beta = _dot_product(n_rows, res0, rk);
1341
 
      residue = sqrt(beta);
1342
 
 
1343
 
    }
1344
 
    else {
1345
 
 
1346
 
      _dot_products_2(n_rows, res0, rk, rk, rk, &beta, &residue);
1347
 
      residue = sqrt(residue);
1348
 
 
1349
 
      /* Convergence test */
1350
 
      cvg = _convergence_test(sles_name, var_name,
1351
 
                              n_iter, residue, convergence);
1352
 
      if (cvg != 0)
1353
 
        break;
1354
 
 
1355
 
    }
1356
 
 
1357
 
    n_iter += 1;
1358
 
 
1359
 
    if (CS_ABS(beta) < _epzero) {
1360
 
 
1361
 
      if (convergence->verbosity == 2)
1362
 
        bft_printf(_("  n_iter : %5d, res_abs : %11.4e, res_nor : %11.4e\n"),
1363
 
                   n_iter, residue, residue/convergence->r_norm);
1364
 
      else if (convergence->verbosity > 2)
1365
 
        bft_printf("   %5d %11.4e %11.4e\n",
1366
 
                   n_iter, residue, residue/convergence->r_norm);
1367
 
 
1368
 
      cvg = 0;
1369
 
      break;
1370
 
    }
1371
 
 
1372
 
    if (CS_ABS(alpha) < _epzero) {
1373
 
      bft_printf
1374
 
        (_("\n\n"
1375
 
           "%s [%s]:\n"
1376
 
           " @@ Warning: non convergence and abort\n"
1377
 
           "\n"
1378
 
           "    Alpha coefficient is lower than %12.4e\n"
1379
 
           "\n"
1380
 
           "    The matrix cannot be considered as invertible anymore."),
1381
 
         sles_name, var_name, alpha);
1382
 
      cvg = -2;
1383
 
      break;
1384
 
    }
1385
 
 
1386
 
    omega = beta*gamma / (alpha*betam1);
1387
 
    betam1 = beta;
1388
 
 
1389
 
    /* Compute pk */
1390
 
 
1391
 
    for (ii = 0; ii < n_rows; ii++)
1392
 
      pk[ii] = rk[ii] + omega*(pk[ii] - alpha*uk[ii]);
1393
 
 
1394
 
    /* Compute zk = c.pk */
1395
 
 
1396
 
    _polynomial_preconditionning(n_rows,
1397
 
                                 poly_degree,
1398
 
                                 rotation_mode,
1399
 
                                 ad_inv,
1400
 
                                 ax,
1401
 
                                 pk,
1402
 
                                 zk,
1403
 
                                 uk);
1404
 
 
1405
 
    /* Compute uk = A.zk */
1406
 
 
1407
 
    cs_matrix_vector_multiply(rotation_mode, a, zk, uk);
1408
 
 
1409
 
    /* Compute uk.res0 and gamma */
1410
 
 
1411
 
    ukres0 = _dot_product(n_rows, uk, res0);
1412
 
 
1413
 
    gamma = beta / ukres0;
1414
 
 
1415
 
    /* First update of vx and rk */
1416
 
 
1417
 
    cblas_daxpy(n_rows,  gamma, zk, 1, vx, 1);
1418
 
    cblas_daxpy(n_rows, -gamma, uk, 1, rk, 1);
1419
 
 
1420
 
    /* Compute zk = C.rk (zk is overwritten, vk is a working array */
1421
 
 
1422
 
    _polynomial_preconditionning(n_rows,
1423
 
                                 poly_degree,
1424
 
                                 rotation_mode,
1425
 
                                 ad_inv,
1426
 
                                 ax,
1427
 
                                 rk,
1428
 
                                 zk,
1429
 
                                 vk);
1430
 
 
1431
 
    /* Compute vk = A.zk and alpha */
1432
 
 
1433
 
    cs_matrix_vector_multiply(rotation_mode, a, zk, vk);
1434
 
 
1435
 
    _dot_products_2(n_rows, vk, rk, vk, vk, &ro_0, &ro_1);
1436
 
 
1437
 
    if (ro_1 < _epzero) {
1438
 
      bft_printf
1439
 
        (_("\n\n"
1440
 
           "%s [%s]:\n"
1441
 
           " @@ Warning: non convergence and abort\n"
1442
 
           "\n"
1443
 
           "    The square of the norm of the descent vector\n"
1444
 
           "    is lower than %12.4e\n"
1445
 
           "\n"
1446
 
           "    The resolution does not progress anymore."),
1447
 
         sles_name, var_name, _epzero);
1448
 
      cvg = -2;
1449
 
      break;
1450
 
    }
1451
 
 
1452
 
    alpha = ro_0 / ro_1;
1453
 
 
1454
 
    /* Final update of vx and rk */
1455
 
 
1456
 
    cblas_daxpy(n_rows,  alpha, zk, 1, vx, 1);
1457
 
    cblas_daxpy(n_rows, -alpha, vk, 1, rk, 1);
1458
 
 
1459
 
    /* Convergence test at beginning of next iteration so
1460
 
       as to group dot products for better parallel performance */
1461
 
  }
1462
 
 
1463
 
  if (_aux_vectors != aux_vectors)
1464
 
    BFT_FREE(_aux_vectors);
1465
 
 
1466
 
  return cvg;
1467
 
}
1468
 
 
1469
 
/*----------------------------------------------------------------------------
1470
 
 * Output post-processing data for failed system convergence.
1471
 
 *
1472
 
 * parameters:
1473
 
 *   n_vals        <-- Size of val and val_type array
1474
 
 *   val           <-> Values to post-process (set to 0 on output if not
1475
 
 *                     normal floating-point values)
1476
 
 *   val_type      --> 0: normal values, 1: infinite, 2: Nan
1477
 
 *
1478
 
 * returns:
1479
 
 *   number of non-normal values
1480
 
 *----------------------------------------------------------------------------*/
1481
 
 
1482
 
static size_t
1483
 
_value_type(size_t      n_vals,
1484
 
            cs_real_t   val[],
1485
 
            int         val_type[])
1486
 
{
1487
 
  size_t ii;
1488
 
  size_t retval = 0;
1489
 
 
1490
 
#if (_CS_STDC_VERSION >= 199901L)
1491
 
 
1492
 
  for (ii = 0; ii < n_vals; ii++) {
1493
 
 
1494
 
    int v_type = fpclassify(val[ii]);
1495
 
 
1496
 
    if (v_type == FP_INFINITE) {
1497
 
      val[ii] = 0.;
1498
 
      val_type[ii] = 1;
1499
 
      retval += 1;
1500
 
    }
1501
 
 
1502
 
    else if (v_type == FP_NAN) {
1503
 
      val[ii] = 0.;
1504
 
      val_type[ii] = 2;
1505
 
      retval += 1;
1506
 
    }
1507
 
 
1508
 
    else if (val[ii] > 1.e38 || val[ii] < -1.e38) {
1509
 
      val[ii] = 0.;
1510
 
      val_type[ii] = 1;
1511
 
      retval += 1;
1512
 
    }
1513
 
 
1514
 
    else
1515
 
      val_type[ii] = 0;
1516
 
  }
1517
 
 
1518
 
#else
1519
 
 
1520
 
  for (ii = 0; ii < n_vals; ii++) {
1521
 
 
1522
 
    if (val[ii] != val[ii]) { /* Test for NaN with IEEE 754 arithmetic */
1523
 
      val[ii] = 0.;
1524
 
      val_type[ii] = 2;
1525
 
      retval += 1;
1526
 
    }
1527
 
 
1528
 
    else if (val[ii] > 1.e38 || val[ii] < -1.e38) {
1529
 
      val[ii] = 0.;
1530
 
      val_type[ii] = 1;
1531
 
      retval += 1;
1532
 
    }
1533
 
 
1534
 
    else
1535
 
      val_type[ii] = 0;
1536
 
  }
1537
 
 
1538
 
#endif
1539
 
 
1540
 
  return retval;
1541
 
}
1542
 
 
1543
 
/*----------------------------------------------------------------------------
1544
 
 * Compute per-cell residual for Ax = b.
1545
 
 *
1546
 
 * parameters:
1547
 
 *   symmetric     <-- indicates if matrix values are symmetric
1548
 
 *   rotation_mode <-- Halo update option for rotational periodicity
1549
 
 *   ad            <-- Diagonal part of linear equation matrix
1550
 
 *   ax            <-- Non-diagonal part of linear equation matrix
1551
 
 *   rhs           <-- Right hand side
1552
 
 *   vx            <-> Current system solution
1553
 
 *   res           --> Residual
1554
 
 *----------------------------------------------------------------------------*/
1555
 
 
1556
 
static void
1557
 
_cell_residual(cs_bool_t        symmetric,
1558
 
               cs_perio_rota_t  rotation_mode,
1559
 
               const cs_real_t  ad[],
1560
 
               const cs_real_t  ax[],
1561
 
               const cs_real_t  rhs[],
1562
 
               cs_real_t        vx[],
1563
 
               cs_real_t        res[])
1564
 
{
1565
 
  cs_int_t ii;
1566
 
 
1567
 
  const cs_int_t n_cells = cs_glob_mesh->n_cells;
1568
 
 
1569
 
  cs_matrix_t *a = cs_glob_sles_base_matrix;
1570
 
 
1571
 
  cs_matrix_set_coefficients(a, symmetric, ad, ax);
1572
 
 
1573
 
  cs_matrix_vector_multiply(rotation_mode, a, vx, res);
1574
 
 
1575
 
  for (ii = 0; ii < n_cells; ii++)
1576
 
    res[ii] = fabs(res[ii] - rhs[ii]);
1577
 
}
1578
 
 
1579
 
/*----------------------------------------------------------------------------
1580
 
 * Compute diagonal dominance metric.
1581
 
 *
1582
 
 * parameters:
1583
 
 *   symmetric <-- indicates if matrix values are symmetric
1584
 
 *   ad        <-- Diagonal part of linear equation matrix
1585
 
 *   ax        <-- Non-diagonal part of linear equation matrix
1586
 
 *   dd        <-- Diagonal dominance (normalized)
1587
 
 *----------------------------------------------------------------------------*/
1588
 
 
1589
 
static void
1590
 
_diag_dominance(cs_bool_t        symmetric,
1591
 
                const cs_real_t  ad[],
1592
 
                const cs_real_t  ax[],
1593
 
                cs_real_t        dd[])
1594
 
{
1595
 
  cs_int_t ii, jj, face_id;
1596
 
 
1597
 
  const cs_int_t n_cells = cs_glob_mesh->n_cells;
1598
 
  const cs_int_t n_faces = cs_glob_mesh->n_i_faces;
1599
 
  const cs_int_t *face_cel = cs_glob_mesh->i_face_cells;
1600
 
  const cs_halo_t *halo = cs_glob_mesh->halo;
1601
 
 
1602
 
  /* Diagonal part of matrix.vector product */
1603
 
 
1604
 
  for (ii = 0; ii < n_cells; ii++)
1605
 
    dd[ii] = fabs(ad[ii]);
1606
 
 
1607
 
  if (halo != NULL)
1608
 
    cs_halo_sync_var(halo, CS_HALO_STANDARD, dd);
1609
 
 
1610
 
  /* non-diagonal terms */
1611
 
 
1612
 
  if (symmetric) {
1613
 
    for (face_id = 0; face_id < n_faces; face_id++) {
1614
 
      ii = face_cel[2*face_id] -1;
1615
 
      jj = face_cel[2*face_id + 1] -1;
1616
 
      dd[ii] -= fabs(ax[face_id]);
1617
 
      dd[jj] -= fabs(ax[face_id]);
1618
 
    }
1619
 
  }
1620
 
  else {
1621
 
    for (face_id = 0; face_id < n_faces; face_id++) {
1622
 
      ii = face_cel[2*face_id] -1;
1623
 
      jj = face_cel[2*face_id + 1] -1;
1624
 
      dd[ii] -= fabs(ax[face_id]);
1625
 
      dd[jj] -= fabs(ax[face_id + n_faces]);
1626
 
    }
1627
 
  }
1628
 
 
1629
 
  for (ii = 0; ii < n_cells; ii++) {
1630
 
    if (fabs(ad[ii]) > 1.e-18)
1631
 
      dd[ii] /= fabs(ad[ii]);
1632
 
  }
1633
 
}
1634
 
 
1635
 
/*============================================================================
1636
 
 * Public function definitions for Fortran API
1637
 
 *============================================================================*/
1638
 
 
1639
 
/*----------------------------------------------------------------------------
1640
 
 * General sparse linear system resolution
1641
 
 *----------------------------------------------------------------------------*/
1642
 
 
1643
 
void CS_PROCF(reslin, RESLIN)
1644
 
(
1645
 
 const char       *cname,     /* <-- variable name */
1646
 
 const cs_int_t   *lname,     /* <-- variable name length */
1647
 
 const cs_int_t   *ncelet,    /* <-- Number of cells, halo included */
1648
 
 const cs_int_t   *ncel,      /* <-- Number of local cells */
1649
 
 const cs_int_t   *nfac,      /* <-- Number of faces */
1650
 
 const cs_int_t   *isym,      /* <-- Symmetry indicator:
1651
 
                                     1: symmetric; 2: not symmetric */
1652
 
 const cs_int_t   *ireslp,    /* <-- Resolution type:
1653
 
                                     0: pcg; 1: Jacobi; 2: cg-stab */
1654
 
 const cs_int_t   *ipol,      /* <-- Preconditioning polynomial degree
1655
 
                                     (0: diagonal) */
1656
 
 const cs_int_t   *nitmap,    /* <-- Number of max iterations */
1657
 
 const cs_int_t   *iinvpe,    /* <-- Indicator to cancel increments
1658
 
                                     in rotational periodicty (2) or
1659
 
                                     to exchange them as scalars (1) */
1660
 
 const cs_int_t   *iwarnp,    /* <-- Verbosity level */
1661
 
 cs_int_t         *niterf,    /* --> Number of iterations done */
1662
 
 const cs_real_t  *epsilp,    /* <-- Precision for iterative resolution */
1663
 
 const cs_real_t  *rnorm,     /* <-- Residue normalization */
1664
 
 cs_real_t        *residu,    /* --> Final non normalized residue */
1665
 
 const cs_int_t   *ifacel,    /* <-- Face -> cell connectivity  */
1666
 
 const cs_real_t  *dam,       /* <-- Matrix diagonal */
1667
 
 const cs_real_t  *xam,       /* <-- Matrix extra-diagonal terms */
1668
 
 const cs_real_t  *rhs,       /* <-- System right-hand side */
1669
 
 cs_real_t        *vx         /* <-> System solution */
1670
 
)
1671
 
{
1672
 
  char *var_name;
1673
 
  cs_sles_type_t type;
1674
 
 
1675
 
  int cvg = 0;
1676
 
  int n_iter = *niterf;
1677
 
  cs_bool_t symmetric = (*isym == 1) ? true : false;
1678
 
  cs_perio_rota_t rotation_mode = CS_PERIO_ROTA_COPY;
1679
 
 
1680
 
  assert(*ncelet >= *ncel);
1681
 
  assert(*nfac > 0);
1682
 
  assert(ifacel != NULL);
1683
 
 
1684
 
  if (*iinvpe == 2)
1685
 
    rotation_mode = CS_PERIO_ROTA_RESET;
1686
 
  else if (*iinvpe == 3)
1687
 
    rotation_mode = CS_PERIO_ROTA_IGNORE;
1688
 
 
1689
 
  var_name = cs_base_string_f_to_c_create(cname, *lname);
1690
 
 
1691
 
  switch ((int)(*ireslp)) {
1692
 
  case 0:
1693
 
    type = CS_SLES_PCG;
1694
 
    break;
1695
 
  case 1:
1696
 
    type = CS_SLES_JACOBI;
1697
 
    break;
1698
 
  case 2:
1699
 
    type = CS_SLES_BICGSTAB;
1700
 
    break;
1701
 
  default:
1702
 
    type = CS_SLES_N_TYPES;
1703
 
    assert(0);
1704
 
  }
1705
 
 
1706
 
  cvg = cs_sles_solve(var_name,
1707
 
                      type,
1708
 
                      true,
1709
 
                      symmetric,
1710
 
                      dam,
1711
 
                      xam,
1712
 
                      cs_glob_sles_base_matrix,
1713
 
                      cs_glob_sles_native_matrix,
1714
 
                      *ipol,
1715
 
                      rotation_mode,
1716
 
                      *iwarnp,
1717
 
                      *nitmap,
1718
 
                      *epsilp,
1719
 
                      *rnorm,
1720
 
                      &n_iter,
1721
 
                      residu,
1722
 
                      rhs,
1723
 
                      vx,
1724
 
                      0,
1725
 
                      NULL);
1726
 
 
1727
 
  *niterf = n_iter;
1728
 
 
1729
 
  /* If divergence is detected, try diagnostics and abort */
1730
 
 
1731
 
  if (cvg == -2) {
1732
 
 
1733
 
    int mesh_id = cs_post_init_error_writer_cells();
1734
 
 
1735
 
    cs_sles_post_error_output_def(var_name,
1736
 
                                  mesh_id,
1737
 
                                  symmetric,
1738
 
                                  rotation_mode,
1739
 
                                  dam,
1740
 
                                  xam,
1741
 
                                  rhs,
1742
 
                                  vx);
1743
 
 
1744
 
    cs_post_finalize();
1745
 
 
1746
 
    bft_error(__FILE__, __LINE__, 0,
1747
 
              _("%s: error (divergence) solving for %s"),
1748
 
              _(cs_sles_type_name[type]), var_name);
1749
 
  }
1750
 
 
1751
 
  cs_base_string_f_to_c_free(&var_name);
1752
 
}
1753
 
 
1754
 
/*============================================================================
1755
 
 * Public function definitions
1756
 
 *============================================================================*/
1757
 
 
1758
 
/*----------------------------------------------------------------------------
1759
 
 * Initialize sparse linear equation solver API.
1760
 
 *----------------------------------------------------------------------------*/
1761
 
 
1762
 
void
1763
 
cs_sles_initialize(void)
1764
 
{
1765
 
  cs_mesh_t  *mesh = cs_glob_mesh;
1766
 
  cs_bool_t  periodic = false;
1767
 
 
1768
 
  assert(mesh != NULL);
1769
 
 
1770
 
  if (mesh->n_init_perio > 0)
1771
 
    periodic = true;
1772
 
 
1773
 
  cs_glob_sles_base_matrix = cs_matrix_create(CS_MATRIX_NATIVE,
1774
 
                                              false,
1775
 
                                              true,
1776
 
                                              periodic,
1777
 
                                              mesh->n_cells,
1778
 
                                              mesh->n_cells_with_ghosts,
1779
 
                                              mesh->n_i_faces,
1780
 
                                              mesh->global_cell_num,
1781
 
                                              mesh->i_face_cells,
1782
 
                                              mesh->halo,
1783
 
                                              mesh->i_face_numbering);
1784
 
 
1785
 
  cs_glob_sles_native_matrix = cs_matrix_create(CS_MATRIX_NATIVE,
1786
 
                                                false,
1787
 
                                                true,
1788
 
                                                periodic,
1789
 
                                                mesh->n_cells,
1790
 
                                                mesh->n_cells_with_ghosts,
1791
 
                                                mesh->n_i_faces,
1792
 
                                                mesh->global_cell_num,
1793
 
                                                mesh->i_face_cells,
1794
 
                                                mesh->halo,
1795
 
                                                mesh->i_face_numbering);
1796
 
}
1797
 
 
1798
 
/*----------------------------------------------------------------------------
1799
 
 * Finalize sparse linear equation solver API.
1800
 
 *----------------------------------------------------------------------------*/
1801
 
 
1802
 
void
1803
 
cs_sles_finalize(void)
1804
 
{
1805
 
  int ii;
1806
 
 
1807
 
  /* Free system info */
1808
 
 
1809
 
  for (ii = 0; ii < cs_glob_sles_n_systems; ii++) {
1810
 
    _sles_info_dump(cs_glob_sles_systems[ii]);
1811
 
    _sles_info_destroy(&(cs_glob_sles_systems[ii]));
1812
 
  }
1813
 
 
1814
 
  BFT_FREE(cs_glob_sles_systems);
1815
 
 
1816
 
  cs_glob_sles_n_systems = 0;
1817
 
  cs_glob_sles_n_max_systems = 0;
1818
 
 
1819
 
  /* Free matrix structures */
1820
 
 
1821
 
  cs_matrix_destroy(&cs_glob_sles_native_matrix);
1822
 
  cs_matrix_destroy(&cs_glob_sles_base_matrix);
1823
 
}
1824
 
 
1825
 
/*----------------------------------------------------------------------------
1826
 
 * Test if a general sparse linear system needs solving or if the right-hand
1827
 
 * side is already zero within convergence criteria.
1828
 
 *
1829
 
 * The computed residue is also updated;
1830
 
 *
1831
 
 * parameters:
1832
 
 *   var_name      <-- Variable name
1833
 
 *   solver_name   <-- Name of solver
1834
 
 *   n_rows        <-- Number of (non ghost) rows in rhs
1835
 
 *   verbosity     <-- Verbosity level
1836
 
 *   r_norm        <-- Residue normalization
1837
 
 *   residue       <-> Residue
1838
 
 *   rhs           <-- Right hand side
1839
 
 *
1840
 
 * returns:
1841
 
 *   1 if solving is required, 0 if the rhs is already zero within tolerance
1842
 
 *   criteria (precision of residue normalization)
1843
 
 *----------------------------------------------------------------------------*/
1844
 
 
1845
 
int
1846
 
cs_sles_needs_solving(const char        *var_name,
1847
 
                      const char        *solver_name,
1848
 
                      cs_int_t           n_rows,
1849
 
                      int                verbosity,
1850
 
                      double             r_norm,
1851
 
                      double            *residue,
1852
 
                      const cs_real_t   *rhs)
1853
 
{
1854
 
  int retval = 1;
1855
 
 
1856
 
  /* Initialize residue, check for immediate return */
1857
 
 
1858
 
  *residue = sqrt(_dot_product(n_rows, rhs, rhs));
1859
 
 
1860
 
  if (r_norm <= EPZERO || *residue <= EPZERO) {
1861
 
    if (verbosity > 1)
1862
 
      bft_printf(_("%s [%s]:\n"
1863
 
                   "  immediate exit; r_norm = %11.4e, residual = %11.4e\n"),
1864
 
                 solver_name, var_name, r_norm, *residue);
1865
 
    retval = 0;
1866
 
  }
1867
 
 
1868
 
  return retval;
1869
 
}
1870
 
 
1871
 
/*----------------------------------------------------------------------------
1872
 
 * General sparse linear system resolution.
1873
 
 *
1874
 
 * Note that in most cases (if the right-hand side is not already zero
1875
 
 * within convergence criteria), coefficients are assigned to matrixes
1876
 
 * then released by this function, so coefficients need not be assigned
1877
 
 * prior to this call, and will have been released upon returning.
1878
 
 *
1879
 
 * parameters:
1880
 
 *   var_name      <-- Variable name
1881
 
 *   solver_type   <-- Type of solver (PCG, Jacobi, ...)
1882
 
 *   update_stats  <-- Automatic solver statistics indicator
1883
 
 *   symmetric     <-- Symmetric coefficients indicator
1884
 
 *   ad_coeffs     <-- Diagonal coefficients of linear equation matrix
1885
 
 *   ax_coeffs     <-- Non-diagonal coefficients of linear equation matrix
1886
 
 *   a             <-> Matrix
1887
 
 *   ax            <-> Non-diagonal part of linear equation matrix
1888
 
 *                     (only necessary if poly_degree > 0)
1889
 
 *   poly_degree   <-- Preconditioning polynomial degree (0: diagonal)
1890
 
 *   rotation_mode <-- Halo update option for rotational periodicity
1891
 
 *   verbosity     <-- Verbosity level
1892
 
 *   n_max_iter    <-- Maximum number of iterations
1893
 
 *   precision     <-- Precision limit
1894
 
 *   r_norm        <-- Residue normalization
1895
 
 *   n_iter        --> Number of iterations
1896
 
 *   residue       <-> Residue
1897
 
 *   rhs           <-- Right hand side
1898
 
 *   vx            --> System solution
1899
 
 *   aux_size      <-- Number of elements in aux_vectors
1900
 
 *   aux_vectors   --- Optional working area (allocation otherwise)
1901
 
 *
1902
 
 * returns:
1903
 
 *   1 if converged, 0 if not converged, -1 if not converged and maximum
1904
 
 *   iteration number reached, -2 if divergence is detected.
1905
 
 *----------------------------------------------------------------------------*/
1906
 
 
1907
 
int
1908
 
cs_sles_solve(const char         *var_name,
1909
 
              cs_sles_type_t      solver_type,
1910
 
              cs_bool_t           update_stats,
1911
 
              cs_bool_t           symmetric,
1912
 
              const cs_real_t    *ad_coeffs,
1913
 
              const cs_real_t    *ax_coeffs,
1914
 
              cs_matrix_t        *a,
1915
 
              cs_matrix_t        *ax,
1916
 
              int                 poly_degree,
1917
 
              cs_perio_rota_t     rotation_mode,
1918
 
              int                 verbosity,
1919
 
              int                 n_max_iter,
1920
 
              double              precision,
1921
 
              double              r_norm,
1922
 
              int                *n_iter,
1923
 
              double             *residue,
1924
 
              const cs_real_t    *rhs,
1925
 
              cs_real_t          *vx,
1926
 
              size_t              aux_size,
1927
 
              void               *aux_vectors)
1928
 
{
1929
 
  cs_int_t  n_rows;
1930
 
  unsigned _n_iter = 0;
1931
 
  int cvg = 0;
1932
 
  cs_sles_convergence_t  convergence;
1933
 
 
1934
 
  cs_sles_info_t *sles_info = NULL;
1935
 
  double  wt_start = 0.0, wt_stop = 0.0;
1936
 
  double  cpu_start = 0.0, cpu_stop = 0.0;
1937
 
 
1938
 
  cs_matrix_t *_a = a;
1939
 
  cs_matrix_t *_ax = ax;
1940
 
 
1941
 
  n_rows = cs_matrix_get_n_rows(a);
1942
 
 
1943
 
  if (update_stats == true) {
1944
 
    wt_start =bft_timer_wtime();
1945
 
    cpu_start =bft_timer_cpu_time();
1946
 
    sles_info = _find_or_add_system(var_name, solver_type);
1947
 
  }
1948
 
 
1949
 
  /* Initialize number of iterations and residue,
1950
 
     check for immediate return,
1951
 
     and solve sparse linear system */
1952
 
 
1953
 
  *n_iter = 0;
1954
 
 
1955
 
  if (cs_sles_needs_solving(var_name,
1956
 
                            _(cs_sles_type_name[solver_type]),
1957
 
                            n_rows,
1958
 
                            verbosity,
1959
 
                            r_norm,
1960
 
                            residue,
1961
 
                            rhs) != 0) {
1962
 
 
1963
 
    /* Set matrix coefficients */
1964
 
 
1965
 
    if (solver_type == CS_SLES_JACOBI) {
1966
 
 
1967
 
      if (ax == NULL) {
1968
 
        _a = NULL;
1969
 
        _ax = a;
1970
 
      }
1971
 
 
1972
 
      cs_matrix_set_coefficients(_ax, symmetric, NULL, ax_coeffs);
1973
 
    }
1974
 
 
1975
 
    else { /* if (solver_type != CS_SLES_JACOBI) */
1976
 
 
1977
 
      cs_matrix_set_coefficients(_a, symmetric, ad_coeffs, ax_coeffs);
1978
 
 
1979
 
      if (poly_degree > 0) {
1980
 
        cs_matrix_set_coefficients(_ax, symmetric, NULL, ax_coeffs);
1981
 
      }
1982
 
    }
1983
 
 
1984
 
    /* Solve sparse linear system */
1985
 
 
1986
 
    _convergence_init(&convergence,
1987
 
                      _(cs_sles_type_name[solver_type]),
1988
 
                      var_name,
1989
 
                      verbosity,
1990
 
                      n_max_iter,
1991
 
                      precision,
1992
 
                      r_norm,
1993
 
                      *residue);
1994
 
 
1995
 
    switch (solver_type) {
1996
 
    case CS_SLES_PCG:
1997
 
      if (cs_glob_n_ranks == 1)
1998
 
        cvg = _conjugate_gradient_sp(var_name,
1999
 
                                     _a,
2000
 
                                     _ax,
2001
 
                                     poly_degree,
2002
 
                                     rotation_mode,
2003
 
                                     &convergence,
2004
 
                                     rhs,
2005
 
                                     vx,
2006
 
                                     aux_size,
2007
 
                                     aux_vectors);
2008
 
      else
2009
 
        cvg = _conjugate_gradient_mp(var_name,
2010
 
                                     _a,
2011
 
                                     _ax,
2012
 
                                     poly_degree,
2013
 
                                     rotation_mode,
2014
 
                                     &convergence,
2015
 
                                     rhs,
2016
 
                                     vx,
2017
 
                                     aux_size,
2018
 
                                     aux_vectors);
2019
 
      break;
2020
 
    case CS_SLES_JACOBI:
2021
 
      cvg = _jacobi(var_name,
2022
 
                    ad_coeffs,
2023
 
                    _ax,
2024
 
                    rotation_mode,
2025
 
                    &convergence,
2026
 
                    rhs,
2027
 
                    vx,
2028
 
                    aux_size,
2029
 
                    aux_vectors);
2030
 
      break;
2031
 
    case CS_SLES_BICGSTAB:
2032
 
      cvg = _bi_cgstab(var_name,
2033
 
                       _a,
2034
 
                       _ax,
2035
 
                       poly_degree,
2036
 
                       rotation_mode,
2037
 
                       &convergence,
2038
 
                       rhs,
2039
 
                       vx,
2040
 
                       aux_size,
2041
 
                       aux_vectors);
2042
 
      break;
2043
 
    default:
2044
 
      break;
2045
 
    }
2046
 
 
2047
 
    /* Release matrix coefficients */
2048
 
 
2049
 
    if (_a != NULL)
2050
 
      cs_matrix_release_coefficients(_a);
2051
 
    if (_ax != NULL)
2052
 
      cs_matrix_release_coefficients(_ax);
2053
 
 
2054
 
    /* Update return values */
2055
 
 
2056
 
    _n_iter = convergence.n_iterations;
2057
 
 
2058
 
    *n_iter = convergence.n_iterations;
2059
 
    *residue = convergence.residue;
2060
 
  }
2061
 
 
2062
 
  if (update_stats == true) {
2063
 
 
2064
 
    wt_stop =bft_timer_wtime();
2065
 
    cpu_stop =bft_timer_cpu_time();
2066
 
 
2067
 
    if (sles_info->n_calls == 0)
2068
 
      sles_info->n_iterations_min = _n_iter;
2069
 
 
2070
 
    sles_info->n_calls += 1;
2071
 
 
2072
 
    if (sles_info->n_iterations_min > _n_iter)
2073
 
      sles_info->n_iterations_min = _n_iter;
2074
 
    if (sles_info->n_iterations_max < _n_iter)
2075
 
      sles_info->n_iterations_max = _n_iter;
2076
 
 
2077
 
    sles_info->n_iterations_last = _n_iter;
2078
 
    sles_info->n_iterations_tot += _n_iter;
2079
 
 
2080
 
    sles_info->wt_tot += (wt_stop - wt_start);
2081
 
    sles_info->cpu_tot += (cpu_stop - cpu_start);
2082
 
  }
2083
 
 
2084
 
  return cvg;
2085
 
}
2086
 
 
2087
 
/*----------------------------------------------------------------------------
2088
 
 * Output default post-processing data for failed system convergence.
2089
 
 *
2090
 
 * parameters:
2091
 
 *   var_name      <-- Variable name
2092
 
 *   mesh_id       <-- id of error output mesh, or 0 if none
2093
 
 *   symmetric     <-- indicates if matrix values are symmetric
2094
 
 *   rotation_mode <-- Halo update option for rotational periodicity
2095
 
 *   ad            <-- Diagonal part of linear equation matrix
2096
 
 *   ax            <-- Non-diagonal part of linear equation matrix
2097
 
 *   rhs           <-- Right hand side
2098
 
 *   vx            <-> Current system solution
2099
 
 *----------------------------------------------------------------------------*/
2100
 
 
2101
 
void
2102
 
cs_sles_post_error_output_def(const char       *var_name,
2103
 
                              int               mesh_id,
2104
 
                              cs_bool_t         symmetric,
2105
 
                              cs_perio_rota_t   rotation_mode,
2106
 
                              const cs_real_t  *ad,
2107
 
                              const cs_real_t  *ax,
2108
 
                              const cs_real_t  *rhs,
2109
 
                              cs_real_t        *vx)
2110
 
{
2111
 
  if (mesh_id != 0) {
2112
 
 
2113
 
    const cs_mesh_t *mesh = cs_glob_mesh;
2114
 
 
2115
 
    char base_name[32], val_name[32];
2116
 
 
2117
 
    int val_id;
2118
 
    const cs_int_t n_cells = mesh->n_cells;
2119
 
 
2120
 
    cs_real_t *val;
2121
 
 
2122
 
    BFT_MALLOC(val, mesh->n_cells_with_ghosts, cs_real_t);
2123
 
 
2124
 
    for (val_id = 0; val_id < 5; val_id++) {
2125
 
 
2126
 
      switch(val_id) {
2127
 
 
2128
 
      case 0:
2129
 
        strcpy(base_name, "Diag");
2130
 
        memcpy(val, ad, n_cells*sizeof(cs_real_t));
2131
 
        break;
2132
 
 
2133
 
      case 1:
2134
 
        strcpy(base_name, "RHS");
2135
 
        memcpy(val, rhs, n_cells*sizeof(cs_real_t));
2136
 
        break;
2137
 
 
2138
 
      case 2:
2139
 
        strcpy(base_name, "X");
2140
 
        memcpy(val, vx, n_cells*sizeof(cs_real_t));
2141
 
        break;
2142
 
 
2143
 
      case 3:
2144
 
        strcpy(base_name, "Residual");
2145
 
        _cell_residual(symmetric, rotation_mode, ad, ax, rhs, vx, val);
2146
 
        break;
2147
 
 
2148
 
      case 4:
2149
 
        strcpy(base_name, "Diag_Dom");
2150
 
        _diag_dominance(symmetric, ad, ax, val);
2151
 
        break;
2152
 
 
2153
 
      }
2154
 
 
2155
 
      if (strlen(var_name) + strlen(base_name) < 31) {
2156
 
        strcpy(val_name, base_name);
2157
 
        strcat(val_name, "_");
2158
 
        strcat(val_name, var_name);
2159
 
      }
2160
 
      else {
2161
 
        strncpy(val_name, base_name, 31);
2162
 
        val_name[31] = '\0';
2163
 
      }
2164
 
 
2165
 
      cs_sles_post_error_output_var(val_name,
2166
 
                                    mesh_id,
2167
 
                                    val);
2168
 
    }
2169
 
 
2170
 
    BFT_FREE(val);
2171
 
  }
2172
 
 
2173
 
}
2174
 
 
2175
 
/*----------------------------------------------------------------------------
2176
 
 * Output post-processing variable for failed system convergence.
2177
 
 *
2178
 
 * parameters:
2179
 
 *   var_name <-- Variable name
2180
 
 *   mesh_id  <-- id of error output mesh, or 0 if none
2181
 
 *   var      <-- Variable values
2182
 
 *----------------------------------------------------------------------------*/
2183
 
 
2184
 
void
2185
 
cs_sles_post_error_output_var(const char  *var_name,
2186
 
                              int          mesh_id,
2187
 
                              cs_real_t   *var)
2188
 
{
2189
 
  if (mesh_id != 0) {
2190
 
 
2191
 
    const cs_mesh_t *mesh = cs_glob_mesh;
2192
 
 
2193
 
    size_t n_non_norm;
2194
 
    const cs_int_t n_cells = mesh->n_cells;
2195
 
 
2196
 
    int *val_type;
2197
 
 
2198
 
    BFT_MALLOC(val_type, n_cells, int);
2199
 
 
2200
 
    n_non_norm = _value_type(n_cells, var, val_type);
2201
 
 
2202
 
    cs_post_write_var(mesh_id,
2203
 
                      var_name,
2204
 
                      1,
2205
 
                      false, /* no interlace */
2206
 
                      true,  /* use parents */
2207
 
                      CS_POST_TYPE_cs_real_t,
2208
 
                      -1,
2209
 
                      0.0,
2210
 
                      var,
2211
 
                      NULL,
2212
 
                      NULL);
2213
 
 
2214
 
    if (n_non_norm > 0) {
2215
 
 
2216
 
      char type_name[32];
2217
 
      size_t l = strlen(var_name);
2218
 
 
2219
 
      if (l > 31)
2220
 
        l = 31;
2221
 
 
2222
 
      l -= strlen("_fp_type");
2223
 
 
2224
 
      strncpy(type_name, var_name, l);
2225
 
      type_name[l] = '\0';
2226
 
 
2227
 
      strcat(type_name, "_fp_type");
2228
 
 
2229
 
      cs_post_write_var(mesh_id,
2230
 
                        type_name,
2231
 
                        1,
2232
 
                        false, /* no interlace */
2233
 
                        true,  /* use parents */
2234
 
                        CS_POST_TYPE_int,
2235
 
                        -1,
2236
 
                        0.0,
2237
 
                        val_type,
2238
 
                        NULL,
2239
 
                        NULL);
2240
 
 
2241
 
    }
2242
 
 
2243
 
    BFT_FREE(val_type);
2244
 
  }
2245
 
}
2246
 
 
2247
 
/*----------------------------------------------------------------------------*/
2248
 
 
2249
 
END_C_DECLS