1 /*============================================================================
2  * Field management.
3  *============================================================================*/
4 
5 /*
6   This file is part of Code_Saturne, a general-purpose CFD tool.
7 
8   Copyright (C) 1998-2021 EDF S.A.
9 
10   This program is free software; you can redistribute it and/or modify it under
11   the terms of the GNU General Public License as published by the Free Software
12   Foundation; either version 2 of the License, or (at your option) any later
13   version.
14 
15   This program is distributed in the hope that it will be useful, but WITHOUT
16   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
17   FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
18   details.
19 
20   You should have received a copy of the GNU General Public License along with
21   this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
22   Street, Fifth Floor, Boston, MA 02110-1301, USA.
23 */
24 
25 /*----------------------------------------------------------------------------*/
26 
27 #include "cs_defs.h"
28 
29 /*----------------------------------------------------------------------------*/
30 
31 /*----------------------------------------------------------------------------
32  * Standard C library headers
33  *----------------------------------------------------------------------------*/
34 
35 #include <assert.h>
36 #include <ctype.h>
37 #include <stdio.h>
38 #include <stdlib.h>
39 #include <string.h>
40 
41 /*----------------------------------------------------------------------------
42  * Local headers
43  *----------------------------------------------------------------------------*/
44 
45 #include "bft_mem.h"
46 #include "bft_error.h"
47 #include "bft_printf.h"
48 
49 #include "cs_log.h"
50 #include "cs_map.h"
51 #include "cs_parall.h"
52 #include "cs_mesh_location.h"
53 
54 /*----------------------------------------------------------------------------
55  * Header for the current file
56  *----------------------------------------------------------------------------*/
57 
58 #include "cs_field.h"
59 
60 /*----------------------------------------------------------------------------*/
61 
62 BEGIN_C_DECLS
63 
64 /*=============================================================================
65  * Additional doxygen documentation
66  *============================================================================*/
67 
68 /*!
69   \file cs_field.c
70         Field management.
71 
72   \struct cs_field_bc_coeffs_t
73 
74   \brief Field boundary condition descriptor (for variables)
75 
76   \var cs_field_bc_coeffs_t::location_id
77        Id of matching location
78 
79   \var cs_field_bc_coeffs_t::a
80        Explicit coefficient
81   \var cs_field_bc_coeffs_t::b
82        Implicit coefficient
83   \var cs_field_bc_coeffs_t::af
84        Explicit coefficient for flux
85   \var cs_field_bc_coeffs_t::bf
86        Implicit coefficient for flux
87   \var cs_field_bc_coeffs_t::ad
88        Explicit coefficient for divergence
89   \var cs_field_bc_coeffs_t::bd
90        Implicit coefficient for divergence
91   \var cs_field_bc_coeffs_t::ac
92        Explicit coefficient for convection
93   \var cs_field_bc_coeffs_t::bc
94        Implicit coefficient for convection
95 
96   \struct cs_field_t
97 
98   \brief Field descriptor
99 
100   Members of this field are publicly accessible, to allow for concise
101   syntax, as it is expected to be used in many places.
102 
103   \var  cs_field_t::name
104         Canonical name
105   \var  cs_field_t::id
106         Field id (based on order of field declaration, starting at 0)
107   \var  cs_field_t::type
108         Field type flag (sum of field mask constants, defining if a field
109         is a variable, a property, ...)
110   \var  cs_field_t::dim
111         Field dimension (usually 1 for scalar, 3 for vector, or 6 for
112         symmetric tensor)
113   \var  cs_field_t::location_id
114         Id of matching mesh location
115   \var  cs_field_t::n_time_vals
116         Number of time values
117   \var  cs_field_t::vals
118         vals[0][:] is a pointer to val
119         vals[1][:] is a pointer to val_pre
120         vals[p][:] is a pointer to p ith previous field values
121   \var  cs_field_t::val
122         For each active location, pointer to matching values array
123   \var  cs_field_t::val_pre
124         For each active location, pointer to matching previous values array
125         (only if n_time_vals > 1)
126   \var  cs_field_t::bc_coeffs
127         Boundary condition coefficients, for variable type fields
128   \var  cs_field_t::is_owner
129         Ownership flag for values
130 */
131 
132 /*! \cond DOXYGEN_SHOULD_SKIP_THIS */
133 
134 /*=============================================================================
135  * Local macro definitions
136  *============================================================================*/
137 
138 /* Field descriptor allocation block size */
139 
140 #define _CS_FIELD_S_ALLOC_SIZE       16
141 
142 /*============================================================================
143  * Type definitions
144  *============================================================================*/
145 
146 /* Field key definition values */
147 
148 union _key_val_t {
149   int                         v_int;
150   double                      v_double;
151   void                       *v_p;
152 };
153 
154 /* Field key definitions */
155 
156 typedef struct {
157 
158   union _key_val_t              def_val;        /* Default value container (int,
159                                                    double, or pointer to string
160                                                    or structure) */
161   cs_field_log_key_struct_t    *log_func;       /* print function for
162                                                    structure */
163 
164   cs_field_log_key_struct_t    *log_func_default; /* default values log
165                                                      function for structure */
166 
167   cs_field_clear_key_struct_t  *clear_func;     /* memory free function
168                                                    for sub-structures */
169 
170   size_t                      type_size;        /* Type length for added types
171                                                    (0 for 'i', 'd', or 's') */
172   int                         type_flag;        /* Field type flag */
173   char                        type_id;          /* i: int; d: double; s: str;
174                                                    t: type */
175   char                        log_id;           /* s: setup; n: none */
176 
177   bool                        is_sub;           /* Indicate if the key is a
178                                                    sub-key (in which case
179                                                    def_val contains the parent
180                                                    key id */
181 
182 } cs_field_key_def_t;
183 
184 /* Field key value structures */
185 
186 typedef struct {
187 
188   union _key_val_t   val;          /* Value container (int, double,
189                                       or pointer) */
190   char               is_set;       /* Has this key been set for the
191                                       present field ? */
192   char               is_locked;    /* Has this key been locked for the
193                                       present field ? */
194 
195 } cs_field_key_val_t;
196 
197 /*============================================================================
198  * Static global variables
199  *============================================================================*/
200 
201 /* Field definitions */
202 
203 static int  _n_fields = 0;
204 static int  _n_fields_max = 0;
205 static cs_field_t  **_fields = NULL;
206 static cs_map_name_to_id_t  *_field_map = NULL;
207 
208 /* Key definitions */
209 
210 static int  _n_keys = 0;
211 static int  _n_keys_max = 0;
212 static cs_field_key_def_t  *_key_defs = NULL;
213 static cs_map_name_to_id_t  *_key_map = NULL;
214 
215 static int _k_label = -1;
216 
217 /* Key values : _key_vals[field_id*_n_keys_max + key_id] */
218 
219 static cs_field_key_val_t  *_key_vals = NULL;
220 
221 /* Names for logging */
222 
223 static const int _n_type_flags = 8;
224 static const int _type_flag_mask[] = {CS_FIELD_INTENSIVE,
225                                       CS_FIELD_EXTENSIVE,
226                                       CS_FIELD_VARIABLE,
227                                       CS_FIELD_PROPERTY,
228                                       CS_FIELD_POSTPROCESS,
229                                       CS_FIELD_ACCUMULATOR,
230                                       CS_FIELD_USER,
231                                       CS_FIELD_CDO};
232 static const char *_type_flag_name[] = {N_("intensive"),
233                                         N_("extensive"),
234                                         N_("variable"),
235                                         N_("property"),
236                                         N_("postprocess"),
237                                         N_("accumulator"),
238                                         N_("user"),
239                                         N_("CDO")};
240 
241 /*============================================================================
242  * Global variables
243  *============================================================================*/
244 
245 /* Names for components */
246 
247 /*! \var field name extension for vector components */
248 const char *cs_glob_field_comp_name_3[] = {"[X]", "[Y]", "[Z]"};
249 
250 /*! \var field name extension for symmetric tensor components */
251 const char *cs_glob_field_comp_name_6[] = {"[XX]", "[YY]", "[ZZ]",
252                                            "[XY]", "[YZ]", "[XZ]"};
253 
254 /*! \var field name extension for tensor components */
255 const char *cs_glob_field_comp_name_9[] = {"[XX]", "[XY]", "[XZ]",
256                                            "[YX]", "[YY]", "[YZ]",
257                                            "[ZX]", "[ZY]", "[ZZ]"};
258 
259 /*============================================================================
260  * Prototypes for functions intended for use only by Fortran wrappers.
261  * (descriptions follow, with function bodies).
262  *============================================================================*/
263 
264 int
265 cs_f_field_n_fields(void);
266 
267 int
268 cs_f_field_id_by_name(const char *name);
269 
270 int
271 cs_f_field_location(const cs_field_t *f);
272 
273 int
274 cs_f_field_id_by_name_try(const char *name);
275 
276 void
277 cs_f_field_get_name(int           id,
278                     int           name_max,
279                     const char  **name,
280                     int          *name_len);
281 
282 void
283 cs_f_field_get_dimension(int           id,
284                          int           dim[1]);
285 
286 void
287 cs_f_field_get_ownership(int           id,
288                          bool         *is_owner);
289 
290 void
291 cs_f_field_get_type(int           id,
292                     int          *type);
293 
294 int
295 cs_f_field_have_previous(int   id);
296 
297 void
298 cs_f_field_set_n_previous(int  id,
299                           int  n_previous);
300 
301 void
302 cs_f_field_get_n_previous(int  id,
303                           int  n_previous[1]);
304 
305 void
306 cs_f_field_var_ptr_by_id(int          id,
307                          int          pointer_type,
308                          int          pointer_rank,
309                          int          dim[2],
310                          cs_real_t  **p);
311 
312 void
313 cs_f_field_var_ptr_by_id_try(int          id,
314                              int          pointer_type,
315                              int          pointer_rank,
316                              int          dim[2],
317                              cs_real_t  **p);
318 
319 void
320 cs_f_field_bc_coeffs_ptr_by_id(int          id,
321                                int          pointer_type,
322                                int          pointer_rank,
323                                int          dim[3],
324                                cs_real_t  **p);
325 
326 void
327 cs_f_field_set_key_int(int  f_id,
328                        int  k_id,
329                        int  value);
330 
331 void
332 cs_f_field_set_key_int_bits(int  f_id,
333                             int  k_id,
334                             int  mask);
335 
336 void
337 cs_f_field_clear_key_int_bits(int  f_id,
338                               int  k_id,
339                               int  mask);
340 
341 void
342 cs_f_field_set_key_double(int     f_id,
343                           int     k_id,
344                           double  value);
345 
346 void
347 cs_f_field_set_key_str(int          f_id,
348                        int          k_id,
349                        const char  *str);
350 
351 void
352 cs_f_field_get_key_str(int           f_id,
353                        int           key_id,
354                        int           str_max,
355                        const char  **str,
356                        int          *str_len);
357 
358 void
359 cs_f_field_set_key_struct(int    f_id,
360                           int    k_id,
361                           void  *k_value);
362 
363 void
364 cs_f_field_get_key_struct(int    f_id,
365                           int    k_id,
366                           void  *k_value);
367 
368 void
369 cs_f_field_get_label(int           f_id,
370                      int           str_max,
371                      const char  **str,
372                      int          *str_len);
373 
374 /*============================================================================
375  * Private function definitions
376  *============================================================================*/
377 
378 /*----------------------------------------------------------------------------
379  * Create a field descriptor.
380  *
381  * parameters:
382  *   name        <-- field name
383  *   type_flag   <-- mask of field property and category values
384  *   location_id <-- id of associated location
385  *   dim         <-- field dimension (number of components)
386  *
387  * returns:
388  *   pointer to new field.
389  *----------------------------------------------------------------------------*/
390 
391 static cs_field_t *
_field_create(const char * name,int type_flag,int location_id,int dim)392 _field_create(const char   *name,
393               int           type_flag,
394               int           location_id,
395               int           dim)
396 {
397   int key_id;
398   int field_id = -1;
399   size_t l = strlen(name);
400   const char *addr_0 = NULL, *addr_1 = NULL;
401 
402   cs_field_t *f = cs_field_by_name_try(name);
403 
404   /* Check this name was not already used */
405 
406   if (f != NULL)
407     bft_error(__FILE__, __LINE__, 0,
408               _("Error creating field:\n"
409                 "  name:        \"%s\"\n"
410                 "  location_id: %d\n"
411                 "  dimension:   %d\n\n"
412                 "A field with that name has already been defined:\n"
413                 "  id:          %d\n"
414                 "  location_id: %d\n"
415                 "  dimension:   %d"),
416               name, location_id, dim, f->id, f->location_id, f->dim);
417 
418   /* Initialize if necessary */
419 
420   if (_field_map == NULL)
421     _field_map = cs_map_name_to_id_create();
422 
423   else
424     addr_0 = cs_map_name_to_id_reverse(_field_map, 0);
425 
426   if (l == 0)
427     bft_error(__FILE__, __LINE__, 0, _("Defining a field requires a name."));
428 
429   for (size_t i = 0; i < l; i++) {
430     if (name[i] == '[' || name[i] == ']')
431       bft_error(__FILE__, __LINE__, 0,
432                 _("Field \"%s\" is not allowed,\n"
433                   "as \'[\' and \']\' are reserved for component access."),
434                 name);
435   }
436 
437   /* Insert entry in map */
438 
439   field_id = cs_map_name_to_id(_field_map, name);
440 
441   /* Move name pointers of previous fields if necessary
442      (i.e. reallocation of map names array) */
443 
444   addr_1 = cs_map_name_to_id_reverse(_field_map, 0);
445 
446   if (addr_1 != addr_0) {
447     int i;
448     ptrdiff_t addr_shift = addr_1 - addr_0;
449     for (i = 0; i < field_id; i++)
450       _fields[i]->name += addr_shift;
451   }
452 
453   if (field_id == _n_fields)
454     _n_fields = field_id + 1;
455 
456   /* Reallocate fields pointer if necessary */
457 
458   if (_n_fields > _n_fields_max) {
459     if (_n_fields_max == 0)
460       _n_fields_max = 8;
461     else
462       _n_fields_max *= 2;
463     BFT_REALLOC(_fields, _n_fields_max, cs_field_t *);
464     BFT_REALLOC(_key_vals, _n_keys_max*_n_fields_max, cs_field_key_val_t);
465   }
466 
467   /* Allocate fields descriptor block if necessary
468      (to reduce fragmentation and improve locality of field
469      descriptors, they are allocated in blocks) */
470 
471   int shift_in_alloc_block = field_id % _CS_FIELD_S_ALLOC_SIZE;
472   if (shift_in_alloc_block == 0)
473     BFT_MALLOC(_fields[field_id], _CS_FIELD_S_ALLOC_SIZE, cs_field_t);
474   else
475     _fields[field_id] = _fields[field_id - shift_in_alloc_block]
476                         + shift_in_alloc_block;
477 
478   /* Check type flags and location id */
479 
480   if (   (type_flag & CS_FIELD_INTENSIVE)
481       && (type_flag & CS_FIELD_EXTENSIVE))
482     bft_error(__FILE__, __LINE__, 0,
483               _("Field \"%s\"\n"
484                 " may not be defined as both intensive and extensive."),
485               name);
486   else if (location_id < 0 || location_id >= cs_mesh_location_n_locations())
487     bft_error(__FILE__, __LINE__, 0,
488               _("Mesh location %d associated with field \"%s\"\n"
489                 " has not been defined yet."),
490               location_id, name);
491 
492   /* Assign field */
493 
494   f = _fields[field_id];
495 
496   f->name = cs_map_name_to_id_reverse(_field_map, field_id);
497 
498   f->id = field_id;
499   f->type = type_flag;
500   f->dim = dim;
501   f->location_id = location_id;
502   f->n_time_vals = 1;
503 
504   f->vals = NULL;
505   f->val = NULL;
506   f->val_pre = NULL;
507 
508   f->bc_coeffs = NULL;
509 
510   f->is_owner = true;
511 
512   /* Mark key values as not set */
513 
514   for (key_id = 0; key_id < _n_keys_max; key_id++) {
515     memset(&((_key_vals + (f->id*_n_keys_max + key_id))->val),
516            0,
517            sizeof(union _key_val_t));
518     (_key_vals + (f->id*_n_keys_max + key_id))->is_set = 0;
519     (_key_vals + (f->id*_n_keys_max + key_id))->is_locked = 0;
520   }
521 
522   return f;
523 }
524 
525 /*----------------------------------------------------------------------------*
526  * allocate and initialize a field values array.
527  *
528  * parameters:
529  *   n_elts  <-- number of associated elements
530  *   dim     <-- associated dimension
531  *   val_old <-- pointer to previous array in case of reallocation
532  *               (usually NULL)
533  *
534  * returns  pointer to new field values.
535  *----------------------------------------------------------------------------*/
536 
537 static cs_real_t *
_add_val(cs_lnum_t n_elts,int dim,cs_real_t * val_old)538 _add_val(cs_lnum_t   n_elts,
539          int         dim,
540          cs_real_t  *val_old)
541 {
542   cs_real_t  *val = val_old;
543 
544   BFT_REALLOC(val, n_elts*dim, cs_real_t);
545 
546   /* Initialize field. This should not be necessary, but when using
547      threads with Open MP, this should help ensure that the memory will
548      first be touched by the same core that will later operate on
549      this memory, usually leading to better core/memory affinity. */
550 
551   const cs_lnum_t _n_elts = dim * n_elts;
552 # pragma omp parallel for if (_n_elts > CS_THR_MIN)
553   for (cs_lnum_t ii = 0; ii < _n_elts; ii++)
554     val[ii] = 0.0;
555 
556   return val;
557 }
558 
559 /*----------------------------------------------------------------------------
560  * Find an id matching a key or define a new key and associated id.
561  *
562  * parameters:
563  *   name <-- key name
564  *
565  * returns:
566  *   id of associated key definition structure
567  *----------------------------------------------------------------------------*/
568 
569 static int
_find_or_add_key(const char * name)570 _find_or_add_key(const char  *name)
571 {
572   int key_id;
573 
574   /* Initialize if necessary */
575 
576   if (_key_map == NULL)
577     _key_map = cs_map_name_to_id_create();
578 
579   /* Find or insert entry in map */
580 
581   key_id = cs_map_name_to_id(_key_map, name);
582 
583   if (key_id == _n_keys)
584     _n_keys = key_id + 1;
585 
586   /* Reallocate key definitions if necessary */
587 
588   if (_n_keys > _n_keys_max) {
589     int field_id, _key_id;
590     int _n_keys_max_prev = _n_keys_max;
591     if (_n_keys_max == 0)
592       _n_keys_max = 8;
593     else
594       _n_keys_max *= 2;
595     BFT_REALLOC(_key_defs, _n_keys_max, cs_field_key_def_t);
596     BFT_REALLOC(_key_vals, _n_keys_max*_n_fields_max, cs_field_key_val_t);
597     for (field_id = _n_fields - 1; field_id >= 0; field_id--) {
598       for (_key_id = _n_keys - 2; _key_id >= 0; _key_id--)
599         _key_vals[field_id*_n_keys_max + _key_id]
600           = _key_vals[field_id*_n_keys_max_prev + _key_id];
601     }
602     for (field_id = 0; field_id < _n_fields; field_id++) {
603       memset((&(_key_vals + (field_id*_n_keys_max + key_id))->val),
604              0,
605              sizeof(union _key_val_t));
606       (_key_vals + (field_id*_n_keys_max + key_id))->is_set = 0;
607       (_key_vals + (field_id*_n_keys_max + key_id))->is_locked = 0;
608     }
609   }
610 
611   return key_id;
612 }
613 
614 /*----------------------------------------------------------------------------
615  * Add type flag info to the current position in the setup log.
616  *
617  * parameters:
618  *   type <-- type flag
619  *----------------------------------------------------------------------------*/
620 
621 static inline void
_log_add_type_flag(int type)622 _log_add_type_flag(int type)
623 {
624   int i;
625   int n_loc_flags = 0;
626 
627   for (i = 0; i < _n_type_flags; i++) {
628     if (type & _type_flag_mask[i]) {
629       if (n_loc_flags == 0)
630         cs_log_printf(CS_LOG_SETUP, " (%s", _(_type_flag_name[i]));
631       else
632         cs_log_printf(CS_LOG_SETUP, ", %s", _(_type_flag_name[i]));
633       n_loc_flags++;
634     }
635   }
636 
637   if (n_loc_flags > 0)
638     cs_log_printf(CS_LOG_SETUP, ")");
639 }
640 
641 /*----------------------------------------------------------------------------
642  * Free strings associated to a key.
643  *----------------------------------------------------------------------------*/
644 
645 static void
_cs_field_free_str(void)646 _cs_field_free_str(void)
647 {
648   int key_id, f_id;
649 
650   for (key_id = 0; key_id < _n_keys; key_id++) {
651 
652     cs_field_key_def_t *kd = _key_defs + key_id;
653 
654     if (kd->type_id == 's') {
655       for (f_id = 0; f_id < _n_fields; f_id++) {
656         cs_field_key_val_t *kv = _key_vals + (f_id*_n_keys_max + key_id);
657         BFT_FREE(kv->val.v_p);
658       }
659     }
660 
661   }
662 }
663 
664 /*----------------------------------------------------------------------------
665  * Free structure associated to a key.
666  *----------------------------------------------------------------------------*/
667 
668 static void
_cs_field_free_struct(void)669 _cs_field_free_struct(void)
670 {
671   int key_id, f_id;
672 
673   for (key_id = 0; key_id < _n_keys; key_id++) {
674 
675     cs_field_key_def_t *kd = _key_defs + key_id;
676 
677     if (kd->type_id == 't') {
678       for (f_id = 0; f_id < _n_fields; f_id++) {
679         cs_field_key_val_t *kv = _key_vals + (f_id*_n_keys_max + key_id);
680         if (kd->clear_func != NULL)
681           kd->clear_func(kv->val.v_p);
682         BFT_FREE(kv->val.v_p);
683       }
684     }
685 
686   }
687 }
688 
689 /*----------------------------------------------------------------------------
690  * Check if a key may be used with a given field.
691  *
692  * If the key id is not valid, or the field category is not
693  * compatible, a fatal error is provoked.
694  *
695  * parameters:
696  *   f      <-- pointer to field structure
697  *   key_id <-- id of associated key
698  *
699  * returns:
700  *   associated error code
701  *----------------------------------------------------------------------------*/
702 
703 static int
_check_key(const cs_field_t * f,int key_id)704 _check_key(const cs_field_t  *f,
705            int                key_id)
706 {
707   if (f == NULL)
708     return CS_FIELD_INVALID_FIELD;
709 
710   int errcode = CS_FIELD_OK;
711 
712   assert(f->id >= 0 && f->id < _n_fields);
713 
714   if (key_id > -1 && key_id < _n_keys) {
715     cs_field_key_def_t *kd = _key_defs + key_id;
716     assert(key_id < _n_keys);
717     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
718       errcode = CS_FIELD_INVALID_CATEGORY;
719   }
720   else
721     errcode = CS_FIELD_INVALID_KEY_ID;
722 
723   if (errcode != CS_FIELD_OK) {
724     const char *key = cs_map_name_to_id_reverse(_key_map, key_id);
725     if (errcode == CS_FIELD_INVALID_CATEGORY)
726       bft_error(__FILE__, __LINE__, 0,
727                 _("Field \"%s\" with type flag %d\n"
728                   "has no value associated with key %d (\"%s\")."),
729                 f->name, f->type, key_id, key);
730     else
731       bft_error(__FILE__, __LINE__, 0,
732                 _("Field keyword with id %d is not defined."),
733                 key_id);
734   }
735 
736   return errcode;
737 }
738 
739 /*============================================================================
740  * Fortran wrapper function definitions
741  *============================================================================*/
742 
743 /*----------------------------------------------------------------------------
744  * Return the number of defined fields.
745  *
746  * return:
747  *   number of defined fields.
748  *----------------------------------------------------------------------------*/
749 
750 int
cs_f_field_n_fields(void)751 cs_f_field_n_fields(void)
752 {
753   return cs_field_n_fields();
754 }
755 
756 /*----------------------------------------------------------------------------
757  * Return the id of a defined field based on its name.
758  *
759  * This function is intended for use by Fortran wrappers.
760  *
761  * parameters:
762  *   name <-- field name
763  *
764  * returns:
765  *   id the field structure
766  *----------------------------------------------------------------------------*/
767 
768 int
cs_f_field_id_by_name(const char * name)769 cs_f_field_id_by_name(const char *name)
770 {
771   int retval;
772   cs_field_t  *f = cs_field_by_name(name);
773 
774   retval = f->id;
775 
776   return retval;
777 }
778 
779 /*----------------------------------------------------------------------------
780  * Return the location of a field.
781  *
782  * This function is intended for use by Fortran wrappers.
783  *
784  * parameters:
785  *   f <-- field
786  *
787  * returns:
788  *   location
789  *----------------------------------------------------------------------------*/
790 
791 int
cs_f_field_location(const cs_field_t * f)792 cs_f_field_location(const cs_field_t *f)
793 {
794   int retval;
795 
796   retval = f->location_id;
797 
798   return retval;
799 }
800 
801 /*----------------------------------------------------------------------------
802  * Return the id of a defined field based on its name.
803  *
804  * This function is intended for use by Fortran wrappers.
805  *
806  * parameters:
807  *   name <-- field name
808  *
809  * returns:
810  *   id the field structure
811  *----------------------------------------------------------------------------*/
812 
813 int
cs_f_field_id_by_name_try(const char * name)814 cs_f_field_id_by_name_try(const char *name)
815 {
816   int retval;
817   cs_field_t  *f = cs_field_by_name_try(name);
818 
819   if (f != NULL)
820     retval = f->id;
821   else
822     retval = -1;
823 
824   return retval;
825 }
826 
827 /*----------------------------------------------------------------------------
828  * Return the name of a field defined by its id.
829  *
830  * This function is intended for use by Fortran wrappers.
831  *
832  * parameters:
833  *   id       <-- field id
834  *   name_max <-- maximum name length
835  *   name     --> pointer to associated length
836  *   name_len --> length of associated length
837  *----------------------------------------------------------------------------*/
838 
839 void
cs_f_field_get_name(int id,int name_max,const char ** name,int * name_len)840 cs_f_field_get_name(int           id,
841                     int           name_max,
842                     const char  **name,
843                     int          *name_len)
844 {
845   const cs_field_t *f = cs_field_by_id(id);
846   *name = f->name;
847   *name_len = strlen(*name);
848 
849   if (*name_len > name_max) {
850     bft_error
851       (__FILE__, __LINE__, 0,
852        _("Error retrieving name from Field %d (\"%s\"):\n"
853          "Fortran caller name length (%d) is too small for name \"%s\"\n"
854          "(of length %d)."),
855        f->id, f->name, name_max, *name, *name_len);
856   }
857 }
858 
859 /*----------------------------------------------------------------------------
860  * Return the dimension of a field defined by its id.
861  *
862  * This function is intended for use by Fortran wrappers.
863  *
864  * parameters:
865  *   id  <-- field id
866  *   dim --> field dimension
867  *----------------------------------------------------------------------------*/
868 
869 void
cs_f_field_get_dimension(int id,int dim[1])870 cs_f_field_get_dimension(int  id,
871                          int  dim[1])
872 {
873   const cs_field_t *f = cs_field_by_id(id);
874 
875   dim[0] = f->dim;
876 }
877 
878 /*----------------------------------------------------------------------------
879  * Return the number of previous values of a field.
880  *
881  * This function is intended for use by Fortran wrappers.
882  *
883  * parameters:
884  *   id  <-- field id
885  *   dim --> field dimension
886  *----------------------------------------------------------------------------*/
887 
888 void
cs_f_field_get_n_previous(int id,int n_previous[1])889 cs_f_field_get_n_previous(int  id,
890                           int  n_previous[1])
891 {
892   const cs_field_t *f = cs_field_by_id(id);
893 
894   n_previous[0] = f->n_time_vals - 1;
895 }
896 
897 /*----------------------------------------------------------------------------
898  * Return the field ownership flag.
899  * This function is intended for use by Fortran wrappers.
900  *
901  * parameters:
902  *   id       <-- field id
903  *   is_owner <-- field ownership flag
904  *----------------------------------------------------------------------------*/
905 
906 void
cs_f_field_get_ownership(int id,bool * is_owner)907 cs_f_field_get_ownership(int   id,
908                          bool *is_owner)
909 {
910   const cs_field_t *f = cs_field_by_id(id);
911 
912   *is_owner = f->is_owner;
913 }
914 
915 /*----------------------------------------------------------------------------
916  * Return the type flag of a field defined by its id.
917  *
918  * This function is intended for use by Fortran wrappers.
919  *
920  * parameters:
921  *   id   <-- field id
922  *   type <-- field type flag
923  *----------------------------------------------------------------------------*/
924 
925 void
cs_f_field_get_type(int id,int * type)926 cs_f_field_get_type(int           id,
927                     int          *type)
928 {
929   const cs_field_t *f = cs_field_by_id(id);
930 
931   *type = f->type;
932 }
933 
934 /*----------------------------------------------------------------------------
935  * Indicate if a field maintains values at previous time steps
936  *
937  * This function is intended for use by Fortran wrappers.
938  *
939  * parameters:
940  *   id  <-- field id
941  *
942  * returns:
943  *   1 if previous values are available, 0 otherwise
944  *----------------------------------------------------------------------------*/
945 
946 int
cs_f_field_have_previous(int id)947 cs_f_field_have_previous(int  id)
948 {
949   int retval = 0;
950   const cs_field_t *f = cs_field_by_id(id);
951 
952   if (f->n_time_vals > 1)
953     retval = 1;
954 
955   return retval;
956 }
957 
958 /*----------------------------------------------------------------------------
959  * Change a field's handling of values at previous time steps.
960  *
961  * This function is intended for use by Fortran wrappers.
962  *
963  * parameters:
964  *   id         <-- field id
965  *   n_previous <-- number of previous values to save
966  *----------------------------------------------------------------------------*/
967 
968 void
cs_f_field_set_n_previous(int id,int n_previous)969 cs_f_field_set_n_previous(int  id,
970                           int  n_previous)
971 {
972   cs_field_t *f = cs_field_by_id(id);
973 
974   cs_field_set_n_time_vals(f, n_previous + 1);
975 }
976 
977 /*----------------------------------------------------------------------------
978  * Return a pointer to a field's variable values
979  * (current var if previous does not exist)
980  *
981  * This function is intended for use by Fortran wrappers.
982  *
983  * parameters:
984  *   id           <-- field id
985  *   pointer_type <-- 1: var; 2: var_p or var if var_p does not exists;
986  *   pointer_rank <-- expected rank (1 for scalar, 2 for vector)
987  *   dim          --> dimensions (indexes in Fortran order,
988  *                    dim[i] = 0 if i unused)
989  *   p            --> returned pointer
990  *
991  * returns:
992  *   pointer to the field structure, or NULL
993  *----------------------------------------------------------------------------*/
994 
995 void
cs_f_field_var_ptr_by_id_try(int id,int pointer_type,int pointer_rank,int dim[2],cs_real_t ** p)996 cs_f_field_var_ptr_by_id_try(int          id,
997                              int          pointer_type,
998                              int          pointer_rank,
999                              int          dim[2],
1000                              cs_real_t  **p)
1001 {
1002   cs_field_t *f = cs_field_by_id(id);
1003   int cur_p_rank = 1;
1004 
1005   dim[0] = 0;
1006   dim[1] = 0;
1007   *p = NULL;
1008 
1009   if (pointer_type == 1 || pointer_type == 2) {
1010 
1011     const cs_lnum_t *n_elts = cs_mesh_location_get_n_elts(f->location_id);
1012     cs_lnum_t _n_elts = n_elts[2];
1013 
1014     if (pointer_type == 1 || f->val_pre == NULL)
1015       *p = f->val;
1016     else
1017       *p = f->val_pre;
1018 
1019     if (*p == NULL) /* Adjust dimensions to assist Fortran bounds-checking */
1020       _n_elts = 0;
1021 
1022     if (f->dim == 1)
1023       dim[0] = _n_elts;
1024     else {
1025       dim[0] = f->dim;
1026       dim[1] = _n_elts;
1027       cur_p_rank = 2;
1028     }
1029 
1030   }
1031 
1032   if (cur_p_rank != pointer_rank)
1033     bft_error
1034       (__FILE__, __LINE__, 0,
1035        _("Fortran pointer of rank %d requested for values of field \"%s\",\n"
1036          "which have rank %d."),
1037        pointer_rank, f->name, cur_p_rank);
1038 }
1039 
1040 /*----------------------------------------------------------------------------
1041  * Return a pointer to a field's variable values
1042  *
1043  * This function is intended for use by Fortran wrappers.
1044  *
1045  * parameters:
1046  *   id           <-- field id
1047  *   pointer_type <-- 1: var; 2: var_prev; 3: var_prev2
1048  *   pointer_rank <-- expected rank (1 for scalar, 2 for vector)
1049  *   dim          --> dimensions (indexes in Fortran order,
1050  *                    dim[i] = 0 if i unused)
1051  *   p            --> returned pointer
1052  *
1053  * returns:
1054  *   pointer to the field structure, or NULL
1055  *----------------------------------------------------------------------------*/
1056 
1057 void
cs_f_field_var_ptr_by_id(int id,int pointer_type,int pointer_rank,int dim[2],cs_real_t ** p)1058 cs_f_field_var_ptr_by_id(int          id,
1059                          int          pointer_type,
1060                          int          pointer_rank,
1061                          int          dim[2],
1062                          cs_real_t  **p)
1063 {
1064   cs_field_t *f = cs_field_by_id(id);
1065   int cur_p_rank = 1;
1066 
1067   dim[0] = 0;
1068   dim[1] = 0;
1069   *p = NULL;
1070 
1071   if (pointer_type > f->n_time_vals)
1072     bft_error
1073       (__FILE__, __LINE__, 0,
1074        _("Fortran pointer with %d previous values of field \"%s\",\n"
1075          "requests the %d previous values."),
1076        f->n_time_vals-1, f->name, pointer_type-1);
1077 
1078   if (pointer_type == 1 || pointer_type == 2 || pointer_type == 3) {
1079 
1080     const cs_lnum_t *n_elts = cs_mesh_location_get_n_elts(f->location_id);
1081     cs_lnum_t _n_elts = n_elts[2];
1082 
1083     assert(pointer_type <= f->n_time_vals);
1084 
1085     *p = f->vals[pointer_type - 1];
1086 
1087     if (*p == NULL) /* Adjust dimensions to assist Fortran bounds-checking */
1088       _n_elts = 0;
1089 
1090     /* If dimension 1 is asked and field is of dimension one */
1091     if (f->dim == 1 && pointer_rank == 1)
1092       dim[0] = _n_elts;
1093     else {
1094       dim[0] = f->dim;
1095       dim[1] = _n_elts;
1096       cur_p_rank = 2;
1097     }
1098 
1099   }
1100 
1101   if (cur_p_rank != pointer_rank)
1102     bft_error
1103       (__FILE__, __LINE__, 0,
1104        _("Fortran pointer of rank %d requested for values of field \"%s\",\n"
1105          "which have rank %d."),
1106        pointer_rank, f->name, cur_p_rank);
1107 }
1108 
1109 /*----------------------------------------------------------------------------
1110  * Return a pointer to a field's boundary condition coefficient values
1111  *
1112  * This function is intended for use by Fortran wrappers.
1113  *
1114  * parameters:
1115  *   id           <-- field id
1116  *   pointer_type <-- 1: bc_coeffs->a;     2: bc_coeffs->b
1117  *                    3: bc_coeffs->af;    4: bc_coeffs->bf
1118  *                    5: bc_coeffs->ad;    6: bc_coeffs->bd
1119  *                    7: bc_coeffs->ac;    8: bc_coeffs->bc
1120  *                    9: bc_coeffs->hext; 10: bc_coeffs->hint
1121  *   pointer_rank <-- expected rank (1 for scalar, 2 for vector)
1122  *   dim          <-- dimensions (indexes in Fortran order,
1123  *                    dim[i] = 0 if i unused)
1124  *   p            <-- returned pointer
1125  *
1126  * returns:
1127  *   pointer to the field structure, or NULL
1128  *----------------------------------------------------------------------------*/
1129 
1130 void
cs_f_field_bc_coeffs_ptr_by_id(int id,int pointer_type,int pointer_rank,int dim[3],cs_real_t ** p)1131 cs_f_field_bc_coeffs_ptr_by_id(int          id,
1132                                int          pointer_type,
1133                                int          pointer_rank,
1134                                int          dim[3],
1135                                cs_real_t  **p)
1136 {
1137   cs_field_t *f = cs_field_by_id(id);
1138   int cur_p_rank = 1;
1139 
1140   dim[0] = 0;
1141   dim[1] = 0;
1142   dim[2] = 0;
1143   *p = NULL;
1144 
1145   const int location_id = CS_MESH_LOCATION_BOUNDARY_FACES;
1146   const cs_lnum_t *n_elts = cs_mesh_location_get_n_elts(location_id);
1147   cs_lnum_t _n_elts = n_elts[2];
1148 
1149   assert(f->location_id == CS_MESH_LOCATION_CELLS);
1150 
1151   if (f->bc_coeffs == NULL)
1152     bft_error(__FILE__, __LINE__, 0,
1153               _("Field \"%s\"\n"
1154                 " does not have associated BC coefficients."),
1155               f->name);
1156 
1157   if (f->bc_coeffs != NULL) {
1158 
1159     if (pointer_type == 1)
1160       *p = f->bc_coeffs->a;
1161     else if (pointer_type == 2)
1162       *p = f->bc_coeffs->b;
1163     else if (pointer_type == 3)
1164       *p = f->bc_coeffs->af;
1165     else if (pointer_type == 4)
1166       *p = f->bc_coeffs->bf;
1167     else if (pointer_type == 5)
1168       *p = f->bc_coeffs->ad;
1169     else if (pointer_type == 6)
1170       *p = f->bc_coeffs->bd;
1171     else if (pointer_type == 7)
1172       *p = f->bc_coeffs->ac;
1173     else if (pointer_type == 8)
1174       *p = f->bc_coeffs->bc;
1175     else if (pointer_type == 9)
1176       *p = f->bc_coeffs->hext;
1177     else if (pointer_type == 10)
1178       *p = f->bc_coeffs->hint;
1179 
1180     if (*p == NULL) /* Adjust dimensions to assist Fortran bounds-checking */
1181       _n_elts = 0;
1182 
1183     if (f->dim == 1 || pointer_type == 9 || pointer_type == 10)
1184       dim[0] = _n_elts;
1185 
1186     else {
1187 
1188       int coupled = 0;
1189 
1190       if (f->type & CS_FIELD_VARIABLE) {
1191         int coupled_key_id = cs_field_key_id_try("coupled");
1192         if (coupled_key_id > -1)
1193           coupled = cs_field_get_key_int(f, coupled_key_id);
1194       }
1195 
1196       if (coupled) {
1197 
1198         if (pointer_type == 1 || pointer_type == 3 || pointer_type == 5
1199             || pointer_type == 7) {
1200           dim[0] = f->dim;
1201           dim[1] = _n_elts;
1202           cur_p_rank = 2;
1203         }
1204         else { /* if (pointer_type == 2 || pointer_type == 4 || pointer_type == 6
1205                       || pointer_type == 8) */
1206           dim[0] = f->dim;
1207           dim[1] = f->dim;
1208           dim[2] = _n_elts;
1209           cur_p_rank = 3;
1210         }
1211 
1212       }
1213       else { /* uncoupled */
1214 
1215         dim[0] = f->dim;
1216         dim[1] = _n_elts;
1217         cur_p_rank = 2;
1218 
1219       }
1220 
1221     }
1222 
1223   }
1224 
1225   if (cur_p_rank != pointer_rank)
1226     bft_error
1227       (__FILE__, __LINE__, 0,
1228        _("Fortran pointer of rank %d requested for BC coefficients of field\n"
1229          " \"%s\", which have rank %d."),
1230        pointer_rank, f->name, cur_p_rank);
1231 }
1232 
1233 /*----------------------------------------------------------------------------
1234  * Assign an integer value for a given key to a field.
1235  *
1236  * If the key id is not valid, or the value type or field category is not
1237  * compatible, a fatal error is provoked.
1238  *
1239  * This function is intended for use by Fortran wrappers.
1240  *
1241  * parameters:
1242  *   f_id  <-- field id
1243  *   k_id  <-- key id
1244  *   value <-- associated value
1245  *----------------------------------------------------------------------------*/
1246 
1247 void
cs_f_field_set_key_int(int f_id,int k_id,int value)1248 cs_f_field_set_key_int(int  f_id,
1249                        int  k_id,
1250                        int  value)
1251 {
1252   int retval = 0;
1253 
1254   cs_field_t *f = cs_field_by_id(f_id);
1255 
1256   retval = cs_field_set_key_int(f, k_id, value);
1257 
1258   if (retval != 0) {
1259     const char *key = cs_map_name_to_id_reverse(_key_map, k_id);
1260     bft_error(__FILE__, __LINE__, 0,
1261               _("Error %d assigning integer value to Field \"%s\" with\n"
1262                 "type flag %d with key %d (\"%s\")."),
1263               retval, f->name, f->type, k_id, key);
1264   }
1265 }
1266 
1267 /*----------------------------------------------------------------------------
1268  * Set integer bits matching a mask to 1 for a given key for a field.
1269  *
1270  * If the key id is not valid, or the value type or field category is not
1271  * compatible, a fatal error is provoked.
1272  *
1273  * This function is intended for use by Fortran wrappers.
1274  *
1275  * parameters:
1276  *   f_id <-- field id
1277  *   k_id <-- key id
1278  *   mask <-- associated mask
1279  *----------------------------------------------------------------------------*/
1280 
1281 void
cs_f_field_set_key_int_bits(int f_id,int k_id,int mask)1282 cs_f_field_set_key_int_bits(int  f_id,
1283                             int  k_id,
1284                             int  mask)
1285 {
1286   cs_field_t *f = cs_field_by_id(f_id);
1287 
1288   cs_field_set_key_int_bits(f, k_id, mask);
1289 }
1290 
1291 /*----------------------------------------------------------------------------
1292  * Set integer bits matching a mask to 0 for a given key for a field.
1293  *
1294  * If the key id is not valid, or the value type or field category is not
1295  * compatible, a fatal error is provoked.
1296  *
1297  * This function is intended for use by Fortran wrappers.
1298  *
1299  * parameters:
1300  *   f_id <-- field id
1301  *   k_id <-- key id
1302  *   mask <-- associated mask
1303  *----------------------------------------------------------------------------*/
1304 
1305 void
cs_f_field_clear_key_int_bits(int f_id,int k_id,int mask)1306 cs_f_field_clear_key_int_bits(int  f_id,
1307                               int  k_id,
1308                               int  mask)
1309 {
1310   cs_field_t *f = cs_field_by_id(f_id);
1311 
1312   cs_field_clear_key_int_bits(f, k_id, mask);
1313 }
1314 
1315 /*----------------------------------------------------------------------------
1316  * Assign a floating point value for a given key to a field.
1317  *
1318  * If the key id is not valid, or the value type or field category is not
1319  * compatible, a fatal error is provoked.
1320  *
1321  * This function is intended for use by Fortran wrappers.
1322  *
1323  * parameters:
1324  *   f_id  <-- field id
1325  *   k_id  <-- key id
1326  *   value <-- associated value
1327  *----------------------------------------------------------------------------*/
1328 
1329 void
cs_f_field_set_key_double(int f_id,int k_id,double value)1330 cs_f_field_set_key_double(int     f_id,
1331                           int     k_id,
1332                           double  value)
1333 {
1334   int retval = 0;
1335 
1336   cs_field_t *f = cs_field_by_id(f_id);
1337 
1338   retval = cs_field_set_key_double(f, k_id, value);
1339 
1340   if (retval != 0) {
1341     const char *key = cs_map_name_to_id_reverse(_key_map, k_id);
1342     bft_error(__FILE__, __LINE__, 0,
1343               _("Error %d assigning real value to Field \"%s\" with\n"
1344                 "type flag %d with key %d (\"%s\")."),
1345               retval, f->name, f->type, k_id, key);
1346   }
1347 }
1348 
1349 /*----------------------------------------------------------------------------
1350  * Assign a character string for a given key to a field.
1351  *
1352  * If the key id is not valid, or the value type or field category is not
1353  * compatible, a fatal error is provoked.
1354  *
1355  * This function is intended for use by Fortran wrappers.
1356  *
1357  * parameters:
1358  *   f_id <-- field id
1359  *   k_id <-- key id
1360  *   str  <-- associated string
1361  *----------------------------------------------------------------------------*/
1362 
1363 void
cs_f_field_set_key_str(int f_id,int k_id,const char * str)1364 cs_f_field_set_key_str(int          f_id,
1365                        int          k_id,
1366                        const char  *str)
1367 {
1368   cs_field_t *f = cs_field_by_id(f_id);
1369   int retval = cs_field_set_key_str(f, k_id, str);
1370 
1371   if (retval != 0) {
1372     const char *key = cs_map_name_to_id_reverse(_key_map, k_id);
1373     bft_error(__FILE__, __LINE__, 0,
1374               _("Error %d assigning string value to Field \"%s\" with\n"
1375                 "type flag %d with key %d (\"%s\")."),
1376               retval, f->name, f->type, k_id, key);
1377   }
1378 }
1379 
1380 /*----------------------------------------------------------------------------
1381  * Return a character string for a given key associated with a field.
1382  *
1383  * If the key id is not valid, or the value type or field category is not
1384  * compatible, a fatal error is provoked.
1385  *
1386  * This function is intended for use by Fortran wrappers.
1387  *
1388  * parameters:
1389  *   f_id    <-- field id
1390  *   k_id    <-- id of associated key
1391  *   str_max <-- maximum string length
1392  *   str     --> pointer to associated string
1393  *   str_len --> length of associated string
1394  *
1395  * returns:
1396  *   pointer to character string
1397  *----------------------------------------------------------------------------*/
1398 
1399 void
cs_f_field_get_key_str(int f_id,int key_id,int str_max,const char ** str,int * str_len)1400 cs_f_field_get_key_str(int           f_id,
1401                        int           key_id,
1402                        int           str_max,
1403                        const char  **str,
1404                        int          *str_len)
1405 {
1406   const cs_field_t *f = cs_field_by_id(f_id);
1407   *str = cs_field_get_key_str(f, key_id);
1408 
1409   if (str != NULL)
1410     *str_len = strlen(*str);
1411   else
1412     *str_len = 0;
1413 
1414   if (*str_len > str_max) {
1415     const char *key = cs_map_name_to_id_reverse(_key_map, key_id);
1416     bft_error
1417       (__FILE__, __LINE__, 0,
1418        _("Error retrieving string from Field %d (\"%s\") and key %d (\"%s\"):\n"
1419          "Fortran caller string length (%d) is too small for string \"%s\"\n"
1420          "(of length %d)."),
1421        f->id, f->name, key_id, key, str_max, *str, *str_len);
1422   }
1423 }
1424 
1425 /*----------------------------------------------------------------------------
1426  * Assign a simple structure for a given key to a field.
1427  *
1428  * If the key id is not valid, or the value type or field category is not
1429  * compatible, a fatal error is provoked.
1430  *
1431  * This function is intended for use by Fortran wrappers.
1432  *
1433  * parameters:
1434  *   f_id    <-- field id
1435  *   k_id    <-- id of associated key
1436  *   k_value --> pointer to structure
1437  *----------------------------------------------------------------------------*/
1438 
1439 void
cs_f_field_set_key_struct(int f_id,int k_id,void * k_value)1440 cs_f_field_set_key_struct(int    f_id,
1441                           int    k_id,
1442                           void  *k_value)
1443 {
1444   cs_field_t *f = cs_field_by_id(f_id);
1445 
1446   cs_field_set_key_struct(f, k_id, k_value);
1447 }
1448 
1449 /*----------------------------------------------------------------------------
1450  * Copy a structure for a given key associated with a field.
1451  *
1452  * If the key id is not valid, or the value type or field category is not
1453  * compatible, a fatal error is provoked.
1454  *
1455  * This function is intended for use by Fortran wrappers.
1456  *
1457  * parameters:
1458  *   f_id    <-- field id
1459  *   k_id    <-- id of associated key
1460  *   k_value --> pointer to structure
1461  *----------------------------------------------------------------------------*/
1462 
1463 void
cs_f_field_get_key_struct(int f_id,int k_id,void * k_value)1464 cs_f_field_get_key_struct(int    f_id,
1465                           int    k_id,
1466                           void  *k_value)
1467 {
1468   const cs_field_t *f = cs_field_by_id(f_id);
1469 
1470   cs_field_get_key_struct(f, k_id, k_value);
1471 }
1472 
1473 /*----------------------------------------------------------------------------
1474  * Return a label associated with a field.
1475  *
1476  * If the "label" key has been set for this field, its associated string
1477  * is returned. Otherwise, the field's name is returned.
1478  *
1479  * This function is intended for use by Fortran wrappers.
1480  *
1481  * parameters:
1482  *   f_id    <-- field id
1483  *   str_max <-- maximum string length
1484  *   str     --> pointer to associated string
1485  *   str_len --> length of associated string
1486  *
1487  * returns:
1488  *   pointer to character string
1489  *----------------------------------------------------------------------------*/
1490 
1491 void
cs_f_field_get_label(int f_id,int str_max,const char ** str,int * str_len)1492 cs_f_field_get_label(int           f_id,
1493                      int           str_max,
1494                      const char  **str,
1495                      int          *str_len)
1496 {
1497   const cs_field_t *f = cs_field_by_id(f_id);
1498   *str = cs_field_get_label(f);
1499 
1500   *str_len = strlen(*str);
1501 
1502   if (*str_len > str_max) {
1503     const char *key = cs_map_name_to_id_reverse(_key_map, _k_label);
1504     bft_error
1505       (__FILE__, __LINE__, 0,
1506        _("Error retrieving string from Field %d (\"%s\") and key %d (\"%s\"):\n"
1507          "Fortran caller string length (%d) is too small for string \"%s\"\n"
1508          "(of length %d)."),
1509        f->id, f->name, _k_label, key, str_max, *str, *str_len);
1510   }
1511 }
1512 
1513 /*! (DOXYGEN_SHOULD_SKIP_THIS) \endcond */
1514 
1515 /*=============================================================================
1516  * Public function definitions
1517  *============================================================================*/
1518 
1519 /*----------------------------------------------------------------------------*/
1520 /*!
1521  * \brief Return the number of defined fields.
1522  *
1523  * \return  number of defined fields.
1524  */
1525 /*----------------------------------------------------------------------------*/
1526 
1527 int
cs_field_n_fields(void)1528 cs_field_n_fields(void)
1529 {
1530   return _n_fields;
1531 }
1532 
1533 /*----------------------------------------------------------------------------*/
1534 /*!
1535  * \brief Create a field descriptor.
1536  *
1537  * \param[in]  name          field name
1538  * \param[in]  type_flag     mask of field property and category values
1539  * \param[in]  location_id   id of associated location
1540  * \param[in]  dim           field dimension (number of components)
1541  * \param[in]  has_previous  maintain values at the previous time step ?
1542  *
1543  * \return  pointer to new field.
1544  */
1545 /*----------------------------------------------------------------------------*/
1546 
1547 cs_field_t *
cs_field_create(const char * name,int type_flag,int location_id,int dim,bool has_previous)1548 cs_field_create(const char   *name,
1549                 int           type_flag,
1550                 int           location_id,
1551                 int           dim,
1552                 bool          has_previous)
1553 {
1554   cs_field_t  *f =  _field_create(name,
1555                                   type_flag,
1556                                   location_id,
1557                                   dim);
1558 
1559   cs_base_check_bool(&has_previous);
1560 
1561   f->n_time_vals = has_previous ? 2 : 1;
1562 
1563   BFT_MALLOC(f->vals, f->n_time_vals, cs_real_t *);
1564   for (int i = 0; i < f->n_time_vals; i++)
1565     f->vals[i] = NULL;
1566 
1567   return f;
1568 }
1569 
1570 /*----------------------------------------------------------------------------*/
1571 /*!
1572  * \brief Return a field matching a given name and attributes,
1573  *        creating it if necessary.
1574  *
1575  * If a field with the same name but different attributes is present,
1576  * this is considered an error.
1577  *
1578  * The default number of time values associated with a field created through
1579  * this function is 1. To modify it, use \ref cs_field_set_n_time_vals.
1580  *
1581  * \param[in]  name          field name
1582  * \param[in]  type_flag     mask of field property and category values
1583  * \param[in]  location_id   id of associated location
1584  * \param[in]  dim           field dimension (number of components)
1585  * \param[in]  has_previous  maintain values at the previous time step ?
1586  *
1587  * \return  pointer to field
1588  */
1589 /*----------------------------------------------------------------------------*/
1590 
1591 cs_field_t *
cs_field_find_or_create(const char * name,int type_flag,int location_id,int dim,bool has_previous)1592 cs_field_find_or_create(const char   *name,
1593                         int           type_flag,
1594                         int           location_id,
1595                         int           dim,
1596                         bool          has_previous)
1597 {
1598   cs_field_t *f = cs_field_by_name_try(name);
1599 
1600   if (f != NULL) {
1601 
1602     if (   type_flag != f->type || location_id != f->location_id
1603         || dim != f->dim) {
1604       bft_error(__FILE__, __LINE__, 0,
1605                 _("Mismatch in field definitions:\n"
1606                   "  name:        \"%s\"\n"
1607                   "  type_flag:   %d\n"
1608                   "  location_id: %d\n"
1609                   "  dimension:   %d\n\n"
1610                   "A previous definition for that has attributes:\n"
1611                   "  id:          %d\n"
1612                   "  type_flag:   %d\n"
1613                   "  location_id: %d\n"
1614                   "  dimension:   %d\n\n"),
1615                 name, type_flag, location_id, dim,
1616                 f->id, f->type, f->location_id, f->dim);
1617     }
1618 
1619   }
1620   else {
1621 
1622     f =  _field_create(name,
1623                        type_flag,
1624                        location_id,
1625                        dim);
1626 
1627     cs_base_check_bool(&has_previous);
1628 
1629     f->n_time_vals = has_previous ? 2 : 1;
1630 
1631     BFT_MALLOC(f->vals, f->n_time_vals, cs_real_t *);
1632     for (int i = 0; i < f->n_time_vals; i++)
1633       f->vals[i] = NULL;
1634 
1635   }
1636 
1637   return f;
1638 }
1639 
1640 /*----------------------------------------------------------------------------*/
1641 /*!
1642  * \brief  Change the number of time values managed by a field.
1643  *
1644  * The minimum will never be below 1, as the current time is always handled.
1645  *
1646  * \param[in, out]  f            pointer to field structure
1647  * \param[in]       n_time_vals  number of time values to maintain
1648  */
1649 /*----------------------------------------------------------------------------*/
1650 
1651 void
cs_field_set_n_time_vals(cs_field_t * f,int n_time_vals)1652 cs_field_set_n_time_vals(cs_field_t  *f,
1653                          int          n_time_vals)
1654 {
1655   assert(f != NULL);
1656   if (f == NULL)
1657     return;
1658 
1659   int _n_time_vals = n_time_vals;
1660 
1661   const int n_time_vals_ini = f->n_time_vals;
1662 
1663   if (_n_time_vals < 1)
1664     _n_time_vals = 1;
1665 
1666   else if (_n_time_vals > 3)
1667     bft_error(__FILE__, __LINE__, 0,
1668               "%s called for field \"%s\" with n_time_vals = %d\n"
1669               " but only values 1, 2 and 3 are currently supported.",
1670               __func__, f->name, n_time_vals);
1671   else
1672     _n_time_vals = n_time_vals;
1673 
1674   if (_n_time_vals == n_time_vals_ini)
1675     return;
1676 
1677   /* Update number of time values */
1678 
1679   f->n_time_vals = _n_time_vals;
1680 
1681   BFT_REALLOC(f->vals, f->n_time_vals, cs_real_t *);
1682   for (int i = n_time_vals_ini; i < f->n_time_vals; i++)
1683     f->vals[i] = NULL;
1684 
1685   /* If allocation or mapping has already been done */
1686 
1687   if (f->val != NULL) {
1688     if (n_time_vals_ini > _n_time_vals) {
1689       assert(n_time_vals_ini == 2 && _n_time_vals == 1);
1690       if (f->is_owner)
1691         BFT_FREE(f->val_pre);
1692       else
1693         f->val_pre = NULL;
1694     }
1695     else { /* if (n_time_vals_ini < _n_time_vals) */
1696       if (f->is_owner) {
1697         const cs_lnum_t *n_elts = cs_mesh_location_get_n_elts(f->location_id);
1698         f->val_pre = _add_val(n_elts[2], f->dim, f->val_pre);
1699       }
1700     }
1701   }
1702 }
1703 
1704 /*----------------------------------------------------------------------------*/
1705 /*!
1706  * \brief  Allocate arrays for field values.
1707  *
1708  * \param[in, out]  f  pointer to field structure
1709  */
1710 /*----------------------------------------------------------------------------*/
1711 
1712 void
cs_field_allocate_values(cs_field_t * f)1713 cs_field_allocate_values(cs_field_t  *f)
1714 {
1715   assert(f != NULL);
1716 
1717   if (f->is_owner) {
1718 
1719     const cs_lnum_t *n_elts = cs_mesh_location_get_n_elts(f->location_id);
1720     int ii;
1721 
1722     /* Initialization */
1723 
1724     for (ii = 0; ii < f->n_time_vals; ii++)
1725       f->vals[ii] = _add_val(n_elts[2], f->dim, f->vals[ii]);
1726 
1727     f->val = f->vals[0];
1728     if (f->n_time_vals > 1)
1729       f->val_pre = f->vals[1];
1730   }
1731 }
1732 
1733 /*----------------------------------------------------------------------------*/
1734 /*!
1735  * \brief  Map existing value arrays to field descriptor.
1736  *
1737  * \param[in, out]  f            pointer to field structure
1738  * \param[in]       val          pointer to array of values
1739  * \param[in]       val_pre      pointer to array of previous values, or NULL
1740  */
1741 /*----------------------------------------------------------------------------*/
1742 
1743 void
cs_field_map_values(cs_field_t * f,cs_real_t * val,cs_real_t * val_pre)1744 cs_field_map_values(cs_field_t   *f,
1745                     cs_real_t    *val,
1746                     cs_real_t    *val_pre)
1747 {
1748   assert(f != NULL);
1749   if (f == NULL)
1750     return;
1751 
1752   if (f->is_owner) {
1753     BFT_FREE(f->val);
1754     BFT_FREE(f->val_pre);
1755     f->is_owner = false;
1756   }
1757 
1758   f->val = val;
1759   f->vals[0] = val;
1760 
1761   /* Add previous time step values if necessary */
1762 
1763   if (f->n_time_vals > 1) {
1764     f->val_pre = val_pre;
1765     f->vals[1] = val_pre;
1766   }
1767 }
1768 
1769 /*----------------------------------------------------------------------------*/
1770 /*!
1771  * \brief  Allocate boundary condition coefficients arrays.
1772  *
1773  * For fields on location CS_MESH_LOCATION_CELLS, boundary conditions
1774  * are located on CS_MESH_LOCATION_BOUNDARY_FACES.
1775  *
1776  * Boundary condition coefficients are not currently supported for other
1777  * locations (though support could be added by mapping a boundary->location
1778  * indirection array in the cs_mesh_location_t structure).
1779  *
1780  * For multidimensional fields with coupled components, implicit b and bf
1781  * coefficient arrays are arrays of block matrices, not vectors, so the
1782  * number of entries for each boundary face is dim*dim instead of dim.
1783  *
1784  * \param[in, out]  f             pointer to field structure
1785  * \param[in]       have_flux_bc  if true, flux bc coefficients (af and bf)
1786  *                                are added
1787  * \param[in]       have_mom_bc   if true, div BC coefficients (ad and bd)
1788  *                                are added
1789  * \param[in]       have_conv_bc  if true, convection BC coefficients (ac and bc)
1790  *                                are added
1791  * \param[in]       have_exch_bc  if true, exchange boundary coefficients (hint
1792  *                                and hext) are added
1793  */
1794 /*----------------------------------------------------------------------------*/
1795 
1796 void
cs_field_allocate_bc_coeffs(cs_field_t * f,bool have_flux_bc,bool have_mom_bc,bool have_conv_bc,bool have_exch_bc)1797 cs_field_allocate_bc_coeffs(cs_field_t  *f,
1798                             bool         have_flux_bc,
1799                             bool         have_mom_bc,
1800                             bool         have_conv_bc,
1801                             bool         have_exch_bc)
1802 {
1803   /* Add boundary condition coefficients if required */
1804 
1805   cs_lnum_t a_mult = f->dim;
1806   cs_lnum_t b_mult = f->dim;
1807 
1808   cs_base_check_bool(&have_flux_bc);
1809   cs_base_check_bool(&have_mom_bc);
1810   cs_base_check_bool(&have_conv_bc);
1811 
1812   if (f->type & CS_FIELD_VARIABLE) {
1813     int coupled = 0;
1814     int coupled_key_id = cs_field_key_id_try("coupled");
1815     if (coupled_key_id > -1)
1816       coupled = cs_field_get_key_int(f, coupled_key_id);
1817     if (coupled)
1818       b_mult *= f->dim;
1819   }
1820 
1821   if (f->location_id == CS_MESH_LOCATION_CELLS) {
1822 
1823     const int location_id = CS_MESH_LOCATION_BOUNDARY_FACES;
1824     const cs_lnum_t *n_elts = cs_mesh_location_get_n_elts(location_id);
1825 
1826     if (f->bc_coeffs == NULL) {
1827 
1828       BFT_MALLOC(f->bc_coeffs, 1, cs_field_bc_coeffs_t);
1829 
1830       f->bc_coeffs->location_id = location_id;
1831 
1832       BFT_MALLOC(f->bc_coeffs->a, n_elts[0]*a_mult, cs_real_t);
1833       BFT_MALLOC(f->bc_coeffs->b, n_elts[0]*b_mult, cs_real_t);
1834 
1835       if (have_flux_bc) {
1836         BFT_MALLOC(f->bc_coeffs->af, n_elts[0]*a_mult, cs_real_t);
1837         BFT_MALLOC(f->bc_coeffs->bf, n_elts[0]*b_mult, cs_real_t);
1838       }
1839       else {
1840         f->bc_coeffs->af = NULL;
1841         f->bc_coeffs->bf = NULL;
1842       }
1843 
1844       if (have_mom_bc) {
1845         BFT_MALLOC(f->bc_coeffs->ad, n_elts[0]*a_mult, cs_real_t);
1846         BFT_MALLOC(f->bc_coeffs->bd, n_elts[0]*b_mult, cs_real_t);
1847       }
1848       else {
1849         f->bc_coeffs->ad = NULL;
1850         f->bc_coeffs->bd = NULL;
1851       }
1852 
1853       if (have_conv_bc) {
1854         BFT_MALLOC(f->bc_coeffs->ac, n_elts[0]*a_mult, cs_real_t);
1855         BFT_MALLOC(f->bc_coeffs->bc, n_elts[0]*b_mult, cs_real_t);
1856       }
1857       else {
1858         f->bc_coeffs->ac = NULL;
1859         f->bc_coeffs->bc = NULL;
1860       }
1861 
1862       if (have_exch_bc) {
1863         BFT_MALLOC(f->bc_coeffs->hint, n_elts[0], cs_real_t);
1864         BFT_MALLOC(f->bc_coeffs->hext, n_elts[0], cs_real_t);
1865       }
1866       else {
1867         f->bc_coeffs->hint = NULL;
1868         f->bc_coeffs->hext = NULL;
1869       }
1870 
1871     }
1872 
1873     else {
1874 
1875       BFT_REALLOC(f->bc_coeffs->a, n_elts[0]*a_mult, cs_real_t);
1876       BFT_REALLOC(f->bc_coeffs->b, n_elts[0]*b_mult, cs_real_t);
1877 
1878       if (have_flux_bc) {
1879         BFT_REALLOC(f->bc_coeffs->af, n_elts[0]*a_mult, cs_real_t);
1880         BFT_REALLOC(f->bc_coeffs->bf, n_elts[0]*b_mult, cs_real_t);
1881       }
1882       else {
1883         BFT_FREE(f->bc_coeffs->af);
1884         BFT_FREE(f->bc_coeffs->bf);
1885       }
1886 
1887       if (have_mom_bc) {
1888         BFT_REALLOC(f->bc_coeffs->ad, n_elts[0]*a_mult, cs_real_t);
1889         BFT_REALLOC(f->bc_coeffs->bd, n_elts[0]*b_mult, cs_real_t);
1890       }
1891       else {
1892         BFT_FREE(f->bc_coeffs->ad);
1893         BFT_FREE(f->bc_coeffs->bd);
1894       }
1895 
1896       if (have_conv_bc) {
1897         BFT_REALLOC(f->bc_coeffs->ac, n_elts[0]*a_mult, cs_real_t);
1898         BFT_REALLOC(f->bc_coeffs->bc, n_elts[0]*b_mult, cs_real_t);
1899       }
1900       else {
1901         BFT_FREE(f->bc_coeffs->ac);
1902         BFT_FREE(f->bc_coeffs->bc);
1903       }
1904 
1905       if (have_exch_bc) {
1906         BFT_MALLOC(f->bc_coeffs->hint, n_elts[0], cs_real_t);
1907         BFT_MALLOC(f->bc_coeffs->hext, n_elts[0], cs_real_t);
1908       }
1909       else {
1910         BFT_FREE(f->bc_coeffs->hint);
1911         BFT_FREE(f->bc_coeffs->hext);
1912       }
1913 
1914     }
1915 
1916   }
1917 
1918   else
1919     bft_error(__FILE__, __LINE__, 0,
1920               _("Field \"%s\"\n"
1921                 " has location %d, which does not support BC coefficients."),
1922               f->name, f->location_id);
1923 }
1924 
1925 /*----------------------------------------------------------------------------*/
1926 /*!
1927  * \brief  Initialize boundary condition coefficients arrays.
1928  *
1929  * For fields on location CS_MESH_LOCATION_CELLS, boundary conditions
1930  * are located on CS_MESH_LOCATION_BOUNDARY_FACES.
1931  *
1932  * Boundary condition coefficients are not currently supported for other
1933  * locations (though support could be added by mapping a boundary->location
1934  * indirection array in the cs_mesh_location_t structure).
1935  *
1936  * For multidimensional fields with coupled components, implicit b and bf
1937  * coefficient arrays are arrays of block matrices, not vectors, so the
1938  * number of entries for each boundary face is dim*dim instead of dim.
1939  *
1940  * \param[in, out]  f  pointer to field structure
1941  */
1942 /*----------------------------------------------------------------------------*/
1943 
1944 void
cs_field_init_bc_coeffs(cs_field_t * f)1945 cs_field_init_bc_coeffs(cs_field_t  *f)
1946 {
1947   /* Add boundary condition coefficients if required */
1948 
1949   cs_lnum_t dim = f->dim;
1950 
1951   int ifac;
1952   int coupled = 0;
1953 
1954   if (f->type & CS_FIELD_VARIABLE) {
1955     int coupled_key_id = cs_field_key_id_try("coupled");
1956     if (coupled_key_id > -1)
1957       coupled = cs_field_get_key_int(f, coupled_key_id);
1958   }
1959 
1960   if (f->location_id == CS_MESH_LOCATION_CELLS) {
1961 
1962     const int location_id = CS_MESH_LOCATION_BOUNDARY_FACES;
1963     const cs_lnum_t *n_elts = cs_mesh_location_get_n_elts(location_id);
1964 
1965     if (coupled == 0 && dim == 1) {
1966 
1967       for (ifac = 0; ifac < n_elts[0]; ifac++) {
1968         f->bc_coeffs->a[ifac] = 0.;
1969         f->bc_coeffs->b[ifac] = 1.;
1970       }
1971 
1972       if (f->bc_coeffs->af != NULL)
1973         for (ifac = 0; ifac < n_elts[0]; ifac++) {
1974           f->bc_coeffs->af[ifac] = 0.;
1975           f->bc_coeffs->bf[ifac] = 0.;
1976         }
1977 
1978       if (f->bc_coeffs->ad != NULL)
1979         for (ifac = 0; ifac < n_elts[0]; ifac++) {
1980           f->bc_coeffs->ad[ifac] = 0.;
1981           f->bc_coeffs->bd[ifac] = 1.;
1982         }
1983 
1984       if (f->bc_coeffs->ac != NULL)
1985         for (ifac = 0; ifac < n_elts[0]; ifac++) {
1986           f->bc_coeffs->ac[ifac] = 0.;
1987           f->bc_coeffs->bc[ifac] = 0.;
1988         }
1989 
1990 
1991     }
1992 
1993     /* Coupled vectorial BCs */
1994     else if (coupled && dim == 3) {
1995 
1996       for (ifac = 0; ifac < n_elts[0]; ifac++) {
1997         f->bc_coeffs->a[ifac*dim] = 0.;
1998         f->bc_coeffs->a[ifac*dim + 1] = 0.;
1999         f->bc_coeffs->a[ifac*dim + 2] = 0.;
2000         f->bc_coeffs->b[ifac*dim*dim] = 1.;
2001         f->bc_coeffs->b[ifac*dim*dim + 1] = 0.;
2002         f->bc_coeffs->b[ifac*dim*dim + 2] = 0.;
2003         f->bc_coeffs->b[ifac*dim*dim + 3] = 0.;
2004         f->bc_coeffs->b[ifac*dim*dim + 4] = 1.;
2005         f->bc_coeffs->b[ifac*dim*dim + 5] = 0.;
2006         f->bc_coeffs->b[ifac*dim*dim + 6] = 0.;
2007         f->bc_coeffs->b[ifac*dim*dim + 7] = 0.;
2008         f->bc_coeffs->b[ifac*dim*dim + 8] = 1.;
2009       }
2010 
2011       if (f->bc_coeffs->af != NULL)
2012         for (ifac = 0; ifac < n_elts[0]; ifac++) {
2013           f->bc_coeffs->af[ifac*dim] = 0.;
2014           f->bc_coeffs->af[ifac*dim + 1] = 0.;
2015           f->bc_coeffs->af[ifac*dim + 2] = 0.;
2016           f->bc_coeffs->bf[ifac*dim*dim] = 0.;
2017           f->bc_coeffs->bf[ifac*dim*dim + 1] = 0.;
2018           f->bc_coeffs->bf[ifac*dim*dim + 2] = 0.;
2019           f->bc_coeffs->bf[ifac*dim*dim + 3] = 0.;
2020           f->bc_coeffs->bf[ifac*dim*dim + 4] = 0.;
2021           f->bc_coeffs->bf[ifac*dim*dim + 5] = 0.;
2022           f->bc_coeffs->bf[ifac*dim*dim + 6] = 0.;
2023           f->bc_coeffs->bf[ifac*dim*dim + 7] = 0.;
2024           f->bc_coeffs->bf[ifac*dim*dim + 8] = 0.;
2025         }
2026 
2027       if (f->bc_coeffs->ad != NULL)
2028         for (ifac = 0; ifac < n_elts[0]; ifac++) {
2029           f->bc_coeffs->ad[ifac*dim] = 0.;
2030           f->bc_coeffs->ad[ifac*dim + 1] = 0.;
2031           f->bc_coeffs->ad[ifac*dim + 2] = 0.;
2032           f->bc_coeffs->bd[ifac*dim*dim] = 1.;
2033           f->bc_coeffs->bd[ifac*dim*dim + 1] = 0.;
2034           f->bc_coeffs->bd[ifac*dim*dim + 2] = 0.;
2035           f->bc_coeffs->bd[ifac*dim*dim + 3] = 0.;
2036           f->bc_coeffs->bd[ifac*dim*dim + 4] = 1.;
2037           f->bc_coeffs->bd[ifac*dim*dim + 5] = 0.;
2038           f->bc_coeffs->bd[ifac*dim*dim + 6] = 0.;
2039           f->bc_coeffs->bd[ifac*dim*dim + 7] = 0.;
2040           f->bc_coeffs->bd[ifac*dim*dim + 8] = 1.;
2041         }
2042 
2043       if (f->bc_coeffs->ac != NULL)
2044         for (ifac = 0; ifac < n_elts[0]; ifac++) {
2045           f->bc_coeffs->ac[ifac*dim] = 0.;
2046           f->bc_coeffs->ac[ifac*dim + 1] = 0.;
2047           f->bc_coeffs->ac[ifac*dim + 2] = 0.;
2048           f->bc_coeffs->bc[ifac*dim*dim] = 0.;
2049           f->bc_coeffs->bc[ifac*dim*dim + 1] = 0.;
2050           f->bc_coeffs->bc[ifac*dim*dim + 2] = 0.;
2051           f->bc_coeffs->bc[ifac*dim*dim + 3] = 0.;
2052           f->bc_coeffs->bc[ifac*dim*dim + 4] = 0.;
2053           f->bc_coeffs->bc[ifac*dim*dim + 5] = 0.;
2054           f->bc_coeffs->bc[ifac*dim*dim + 6] = 0.;
2055           f->bc_coeffs->bc[ifac*dim*dim + 7] = 0.;
2056           f->bc_coeffs->bc[ifac*dim*dim + 8] = 0.;
2057         }
2058 
2059     }
2060     else {
2061       for (ifac = 0; ifac < n_elts[0]; ifac++) {
2062         for (int isou = 0; isou < dim ; isou++) {
2063           for (int jsou = 0; jsou < dim; jsou ++) {
2064             f->bc_coeffs->b[ifac*dim*dim + isou*dim +jsou] = 0.;
2065             if (isou == jsou) {
2066               f->bc_coeffs->b[ifac*dim*dim + isou*dim +jsou] = 1.;
2067             }
2068           }
2069         }
2070       }
2071 
2072       if (f->bc_coeffs->af != NULL) {
2073         for (ifac = 0; ifac < n_elts[0]; ifac++) {
2074           for (int isou = 0; isou < dim ; isou++) {
2075             f->bc_coeffs->af[ifac*dim + isou] = 0.;
2076             for (int jsou = 0; jsou < dim; jsou ++) {
2077               f->bc_coeffs->bf[ifac*dim*dim + isou*dim +jsou] = 0.;
2078             }
2079           }
2080         }
2081       }
2082 
2083       if (f->bc_coeffs->ad != NULL){
2084         for (ifac = 0; ifac < n_elts[0]; ifac++) {
2085           for (int isou = 0; isou < dim ; isou++) {
2086             f->bc_coeffs->ad[ifac*dim + isou] = 0.;
2087             for (int jsou = 0; jsou < dim; jsou ++) {
2088               f->bc_coeffs->bd[ifac*dim*dim + isou*dim +jsou] = 0.;
2089               if (isou == jsou) {
2090                 f->bc_coeffs->bd[ifac*dim*dim + isou*dim +jsou] = 1.;
2091               }
2092             }
2093           }
2094         }
2095       }
2096 
2097       if (f->bc_coeffs->ac != NULL) {
2098         for (ifac = 0; ifac < n_elts[0]; ifac++) {
2099           for (int isou = 0; isou < dim ; isou++) {
2100             f->bc_coeffs->ac[ifac*dim + isou] = 0.;
2101             for (int jsou = 0; jsou < dim; jsou ++) {
2102               f->bc_coeffs->bc[ifac*dim*dim + isou*dim +jsou] = 0.;
2103             }
2104           }
2105         }
2106       }
2107     }
2108 
2109     if (f->bc_coeffs->hint != NULL) {
2110       for (ifac = 0; ifac < n_elts[0]; ifac++) {
2111         f->bc_coeffs->hint[ifac] = 0.;
2112         f->bc_coeffs->hext[ifac] = 0.;
2113       }
2114     }
2115 
2116     if (f->bc_coeffs->hext != NULL) {
2117       for (ifac = 0; ifac < n_elts[0]; ifac++) {
2118         f->bc_coeffs->hext[ifac] = 0.;
2119       }
2120     }
2121 
2122   }
2123 
2124   else
2125     bft_error(__FILE__, __LINE__, 0,
2126               _("Field \"%s\"\n"
2127                 " has location %d, which does not support BC coefficients."),
2128               f->name, f->location_id);
2129 }
2130 
2131 /*----------------------------------------------------------------------------*/
2132 /*!
2133  * \brief  Set current field values to the given constant.
2134  *
2135  * \param[in, out]  f  pointer to field structure
2136  * \param[in]       c  assigned value
2137  */
2138 /*----------------------------------------------------------------------------*/
2139 
2140 void
cs_field_set_values(cs_field_t * f,cs_real_t c)2141 cs_field_set_values(cs_field_t  *f,
2142                     cs_real_t    c)
2143 {
2144   assert(f != NULL);
2145   if (f == NULL)
2146     return;
2147 
2148   const cs_lnum_t *n_elts = cs_mesh_location_get_n_elts(f->location_id);
2149   const cs_lnum_t _n_vals = n_elts[2]*f->dim;
2150 
2151 # pragma omp parallel for if (_n_vals > CS_THR_MIN)
2152   for (cs_lnum_t ii = 0; ii < _n_vals; ii++)
2153     f->val[ii] = c;
2154 }
2155 
2156 /*----------------------------------------------------------------------------*/
2157 /*!
2158  * \brief  Copy current field values to previous values if applicable.
2159  *
2160  * For fields with only one time value, or values not allocated yet,
2161  * this is a no-op.
2162  *
2163  * \param[in, out]  f  pointer to field structure
2164  */
2165 /*----------------------------------------------------------------------------*/
2166 
2167 void
cs_field_current_to_previous(cs_field_t * f)2168 cs_field_current_to_previous(cs_field_t  *f)
2169 {
2170   assert(f != NULL);
2171 
2172   if (f->n_time_vals > 1) {
2173 
2174     const cs_lnum_t *n_elts = cs_mesh_location_get_n_elts(f->location_id);
2175     const cs_lnum_t _n_elts = n_elts[2];
2176 
2177 #   pragma omp parallel if (_n_elts > CS_THR_MIN)
2178     {
2179       const int dim = f->dim;
2180 
2181       if (f->is_owner) {
2182         if (dim == 1) {
2183           for (int kk = f->n_time_vals - 1; kk > 0; kk--) {
2184 #           pragma omp for
2185             for (cs_lnum_t ii = 0; ii < _n_elts; ii++)
2186               f->vals[kk][ii] = f->vals[kk-1][ii];
2187           }
2188         }
2189         else {
2190           for (int kk = f->n_time_vals - 1; kk > 0; kk--) {
2191 #           pragma omp for
2192             for (cs_lnum_t ii = 0; ii < _n_elts; ii++) {
2193               for (cs_lnum_t jj = 0; jj < dim; jj++)
2194                 f->vals[kk][ii*dim + jj] = f->vals[kk-1][ii*dim + jj];
2195             }
2196           }
2197         }
2198       }
2199       else {
2200         if (dim == 1) {
2201 #         pragma omp for
2202           for (cs_lnum_t ii = 0; ii < _n_elts; ii++)
2203             f->val_pre[ii] = f->val[ii];
2204         }
2205         else {
2206 #         pragma omp for
2207           for (cs_lnum_t ii = 0; ii < _n_elts; ii++) {
2208             for (cs_lnum_t jj = 0; jj < dim; jj++)
2209               f->val_pre[ii*dim + jj] = f->val[ii*dim + jj];
2210           }
2211         }
2212       }
2213 
2214     }
2215 
2216   }
2217 }
2218 
2219 /*----------------------------------------------------------------------------*/
2220 /*!
2221  * \brief Destroy all defined fields.
2222  */
2223 /*----------------------------------------------------------------------------*/
2224 
2225 void
cs_field_destroy_all(void)2226 cs_field_destroy_all(void)
2227 {
2228   int i;
2229 
2230   for (i = 0; i < _n_fields; i++) {
2231     cs_field_t  *f = _fields[i];
2232     if (f->is_owner && f->vals != NULL) {
2233       int ii;
2234       for (ii = 0; ii < f->n_time_vals; ii++)
2235         BFT_FREE(f->vals[ii]);
2236     }
2237     BFT_FREE(f->vals);
2238     if (f->bc_coeffs != NULL) {
2239       BFT_FREE(f->bc_coeffs->a);
2240       BFT_FREE(f->bc_coeffs->b);
2241       BFT_FREE(f->bc_coeffs->af);
2242       BFT_FREE(f->bc_coeffs->bf);
2243       BFT_FREE(f->bc_coeffs->ad);
2244       BFT_FREE(f->bc_coeffs->bd);
2245       BFT_FREE(f->bc_coeffs->ac);
2246       BFT_FREE(f->bc_coeffs->bc);
2247       BFT_FREE(f->bc_coeffs->hint);
2248       BFT_FREE(f->bc_coeffs->hext);
2249       BFT_FREE(f->bc_coeffs);
2250     }
2251   }
2252 
2253   for (i = 0; i < _n_fields; i++) {
2254     if (i % _CS_FIELD_S_ALLOC_SIZE == 0)
2255       BFT_FREE(_fields[i]);
2256   }
2257 
2258   BFT_FREE(_fields);
2259 
2260   cs_map_name_to_id_destroy(&_field_map);
2261 
2262   _cs_field_free_str();
2263   _cs_field_free_struct();
2264 
2265   BFT_FREE(_key_vals);
2266 
2267   _n_fields = 0;
2268   _n_fields_max = 0;
2269 }
2270 
2271 /*----------------------------------------------------------------------------*/
2272 /*!
2273  * \brief Allocate arrays for all defined fields based on their location.
2274  *
2275  * Location sized must thus be known.
2276  *
2277  * Fields that do not own their data should all have been mapped at this
2278  * stage, and are checked.
2279  */
2280 /*----------------------------------------------------------------------------*/
2281 
2282 void
cs_field_allocate_or_map_all(void)2283 cs_field_allocate_or_map_all(void)
2284 {
2285   int i;
2286 
2287   for (i = 0; i < _n_fields; i++) {
2288     cs_field_t  *f = _fields[i];
2289     if (f->is_owner)
2290         cs_field_allocate_values(f);
2291     else {
2292       if (f->val == NULL)
2293         bft_error(__FILE__, __LINE__, 0,
2294                   _("Field \"%s\"\n"
2295                     " requires mapped values which have not been set."),
2296                   f->name);
2297     }
2298   }
2299 }
2300 
2301 /*----------------------------------------------------------------------------*/
2302 /*!
2303  * \brief Return a pointer to a field based on its id.
2304  *
2305  * This function requires that a field of the given id is defined.
2306  *
2307  * \param[in]  id   field id
2308  *
2309  * \return  pointer to the field structure
2310  */
2311 /*----------------------------------------------------------------------------*/
2312 
2313 cs_field_t  *
cs_field_by_id(int id)2314 cs_field_by_id(int  id)
2315 {
2316   if (id > -1 && id < _n_fields)
2317     return _fields[id];
2318   else {
2319     bft_error(__FILE__, __LINE__, 0,
2320               _("Field with id %d is not defined."), id);
2321     return NULL;
2322   }
2323 }
2324 
2325 /*----------------------------------------------------------------------------*/
2326 /*!
2327  * \brief Return a pointer to a field based on its name.
2328  *
2329  * This function requires that a field of the given name is defined.
2330  *
2331  * \param[in]  name  field name
2332  *
2333  * \return  pointer to the field structure
2334  */
2335 /*----------------------------------------------------------------------------*/
2336 
2337 cs_field_t  *
cs_field_by_name(const char * name)2338 cs_field_by_name(const char  *name)
2339 {
2340   int id = cs_map_name_to_id_try(_field_map, name);
2341 
2342   if (id > -1)
2343     return _fields[id];
2344   else {
2345     bft_error(__FILE__, __LINE__, 0,
2346               _("Field \"%s\" is not defined."), name);
2347     return NULL;
2348   }
2349 }
2350 
2351 /*----------------------------------------------------------------------------*/
2352 /*!
2353  * \brief Return a pointer to a field based on its name if present.
2354  *
2355  * If no field of the given name is defined, NULL is returned.
2356  *
2357  * \param[in]  name  field name
2358  *
2359  * \return  pointer to the field structure, or NULL
2360  */
2361 /*----------------------------------------------------------------------------*/
2362 
2363 cs_field_t  *
cs_field_by_name_try(const char * name)2364 cs_field_by_name_try(const char  *name)
2365 {
2366   int id = cs_map_name_to_id_try(_field_map, name);
2367 
2368   if (id > -1)
2369     return _fields[id];
2370   else
2371     return NULL;
2372 }
2373 
2374 /*----------------------------------------------------------------------------*/
2375 /*!
2376  * \brief Return the id of a defined field based on its name.
2377  *
2378  * If no field with the given name exists, -1 is returned.
2379  *
2380  * \param[in]  name   key name
2381  *
2382  * \return  id of the field, or -1 if not found
2383  */
2384 /*----------------------------------------------------------------------------*/
2385 
2386 int
cs_field_id_by_name(const char * name)2387 cs_field_id_by_name(const char *name)
2388 {
2389   int id = cs_map_name_to_id_try(_field_map, name);
2390 
2391   return id;
2392 }
2393 
2394 /*----------------------------------------------------------------------------*/
2395 /*!
2396  * \brief Return the id of a defined field and an associated component
2397  *  based on a component name.
2398  *
2399  * If no field with the given name exists, -1 is returned.
2400  *
2401  * \param[in]   name   field or field+component name
2402  * \param[out]  f_id   field id, or -1 if no match was found
2403  * \param[out]  c_id   component id, or -1 for all components
2404  */
2405 /*----------------------------------------------------------------------------*/
2406 
2407 void
cs_field_component_id_by_name(const char * name,int * f_id,int * c_id)2408 cs_field_component_id_by_name(const char  *name,
2409                               int         *f_id,
2410                               int         *c_id)
2411 {
2412   size_t l = strlen(name);
2413 
2414   *f_id = -1;
2415   *c_id = -1;
2416 
2417   /* Case with an extension */
2418 
2419   if (l > 3) {
2420     if (name[l-1] == ']') {
2421       size_t l0 = -1;
2422       char _name0[128];
2423       char *name0 = _name0;
2424       if (l >= 128)
2425         BFT_MALLOC(name0, l + 1, char);
2426       strcpy(name0, name);
2427       for (l0 = l-2; l0 > 0; l0--) {
2428         if (name0[l0] == '[') {
2429           name0[l0] = '\0';
2430           *f_id = cs_map_name_to_id_try(_field_map, name0);
2431           break;
2432         }
2433         else
2434           name0[l0] = toupper(name0[l0]);
2435       }
2436       if (*f_id > -1) {
2437         cs_field_t *f = cs_field_by_id(*f_id);
2438         const char **c_name;
2439         switch (f->dim) {
2440         case 3:
2441           c_name = cs_glob_field_comp_name_3;
2442           break;
2443         case 6:
2444           c_name = cs_glob_field_comp_name_6;
2445           break;
2446         case 9:
2447           c_name = cs_glob_field_comp_name_9;
2448           break;
2449         default:
2450           c_name = NULL;
2451         }
2452         if (c_name != NULL) {
2453           for (int _c_id = 0; *c_id < 0 &&_c_id < f->dim; _c_id++) {
2454             if (strcmp(name0 + l0 + 1, c_name[_c_id]) == 0)
2455               *c_id = _c_id;
2456           }
2457         }
2458         if (*c_id < 0 && l-l0 < 63) {
2459           char c_str[64], c_ref[64];
2460           strncpy(c_str, name0 + l0 + 1, 63);
2461           c_str[l - l0 - 2] = '\0';
2462           for (int _c_id = 0; *c_id < 0 &&_c_id < f->dim; _c_id++) {
2463             sprintf(c_ref, "%d", _c_id);
2464             if (strcmp(c_str, c_ref) == 0)
2465               *c_id = _c_id;
2466           }
2467         }
2468         if (*c_id < 0)
2469           bft_error(__FILE__, __LINE__, 0,
2470                     _("Field \"%s\" does not have a component \"%s\"."),
2471                     f->name, name + l0 - 1);
2472       }
2473       if (name0 != _name0)
2474         BFT_FREE(name0);
2475     }
2476   }
2477 
2478   /* Case with no extension */
2479 
2480   if (*f_id == -1)
2481     *f_id = cs_map_name_to_id_try(_field_map, name);
2482 }
2483 
2484 /*----------------------------------------------------------------------------*/
2485 /*!
2486  * \brief Return an id associated with a given key name.
2487  *
2488  * The key must have been defined previously.
2489  *
2490  * \param[in]  name   key name
2491  *
2492  * \return  id associated with key
2493  */
2494 /*----------------------------------------------------------------------------*/
2495 
2496 int
cs_field_key_id(const char * name)2497 cs_field_key_id(const char  *name)
2498 {
2499   int id = -1;
2500 
2501   if (_key_map != NULL)
2502     id = cs_map_name_to_id_try(_key_map, name);
2503 
2504   if (id < 0)
2505     bft_error(__FILE__, __LINE__, 0,
2506               _("Field \"%s\" is not defined."), name);
2507 
2508   return id;
2509 }
2510 
2511 /*----------------------------------------------------------------------------*/
2512 /*!
2513  * \brief Return an id associated with a given key name if present.
2514  *
2515  * If the key has not been defined previously, -1 is returned.
2516  *
2517  * \param[in]  name   key name
2518  *
2519  * \return  id associated with key, or -1
2520  */
2521 /*----------------------------------------------------------------------------*/
2522 
2523 int
cs_field_key_id_try(const char * name)2524 cs_field_key_id_try(const char  *name)
2525 {
2526   int id = -1;
2527 
2528   if (_key_map != NULL)
2529     id = cs_map_name_to_id_try(_key_map, name);
2530 
2531   return id;
2532 }
2533 
2534 /*----------------------------------------------------------------------------*/
2535 /*!
2536  * \brief Define a key for an integer value by its name and return an
2537  * associated id.
2538  *
2539  * If the key has already been defined, its previous default value is replaced
2540  * by the current value, and its id is returned.
2541  *
2542  * \param[in]  name            key name
2543  * \param[in]  default_value   default value associated with key
2544  * \param[in]  type_flag       mask associated with field types with which the
2545  *                             key may be associated, or 0
2546  *
2547  * \return  id associated with key
2548  */
2549 /*----------------------------------------------------------------------------*/
2550 
2551 int
cs_field_define_key_int(const char * name,int default_value,int type_flag)2552 cs_field_define_key_int(const char  *name,
2553                         int          default_value,
2554                         int          type_flag)
2555 {
2556   int key_id = _find_or_add_key(name);
2557 
2558   cs_field_key_def_t *kd = _key_defs + key_id;
2559 
2560   kd->def_val.v_int = default_value;
2561   kd->log_func = NULL;
2562   kd->type_size = 0;
2563   kd->type_flag = type_flag;
2564   kd->type_id = 'i';
2565   kd->log_id = 's';
2566   kd->is_sub = false;
2567 
2568   return key_id;
2569 }
2570 
2571 /*----------------------------------------------------------------------------*/
2572 /*!
2573  * \brief Define a key for an floating point value by its name and return an
2574  * associated id.
2575  *
2576  * If the key has already been defined, its previous default value is replaced
2577  * by the current value, and its id is returned.
2578  *
2579  * \param[in]  name            key name
2580  * \param[in]  default_value   default value associated with key
2581  * \param[in]  type_flag       mask associated with field types with which
2582  *                             the key may be associated, or 0
2583  *
2584  * \return  id associated with key
2585  */
2586 /*----------------------------------------------------------------------------*/
2587 
2588 int
cs_field_define_key_double(const char * name,double default_value,int type_flag)2589 cs_field_define_key_double(const char  *name,
2590                            double       default_value,
2591                            int          type_flag)
2592 {
2593   int key_id = _find_or_add_key(name);
2594 
2595   cs_field_key_def_t *kd = _key_defs + key_id;
2596 
2597   kd->def_val.v_double = default_value;
2598   kd->log_func = NULL;
2599   kd->type_size = 0;
2600   kd->type_flag = type_flag;
2601   kd->type_id = 'd';
2602   kd->log_id = 's';
2603   kd->is_sub = false;
2604 
2605   return key_id;
2606 }
2607 
2608 /*----------------------------------------------------------------------------*/
2609 /*!
2610  * \brief Define a key for a string value by its name and return an
2611  * associated id.
2612  *
2613  * If the key has already been defined, its previous default value is replaced
2614  * by the current value, and its id is returned.
2615  *
2616  * \param[in]  name            key name
2617  * \param[in]  default_value   default value associated with key
2618  * \param[in]  type_flag       mask associated with field types with which
2619  *                             the key may be associated, or 0
2620  *
2621  * \return  id associated with key
2622  */
2623 /*----------------------------------------------------------------------------*/
2624 
2625 int
cs_field_define_key_str(const char * name,const char * default_value,int type_flag)2626 cs_field_define_key_str(const char  *name,
2627                         const char  *default_value,
2628                         int          type_flag)
2629 {
2630   int n_keys_init = _n_keys;
2631 
2632   int key_id = _find_or_add_key(name);
2633 
2634   cs_field_key_def_t *kd = _key_defs + key_id;
2635 
2636   /* Free possible previous allocation */
2637   if (n_keys_init == _n_keys)
2638     BFT_FREE(kd->def_val.v_p);
2639 
2640   if (default_value != NULL) {
2641     BFT_MALLOC(kd->def_val.v_p, strlen(default_value) + 1, char);
2642     strcpy(kd->def_val.v_p, default_value);
2643   }
2644   else
2645     kd->def_val.v_p = NULL;
2646   kd->log_func = NULL;
2647   kd->type_size = 0;
2648   kd->type_flag = type_flag;
2649   kd->type_id = 's';
2650   kd->log_id = 's';
2651   kd->is_sub = false;
2652 
2653   return key_id;
2654 }
2655 
2656 /*----------------------------------------------------------------------------*/
2657 /*!
2658  * \brief Define a key for a structure value by its name and return an
2659  * associated id.
2660  *
2661  * If the key has already been defined, its previous default value is replaced
2662  * by the current value, and its id is returned.
2663  *
2664  * \param[in]  name              key name
2665  * \param[in]  default_value     pointer to default value associated with key
2666  * \param[in]  log_func          pointer to logging function
2667  * \param[in]  log_func_default  pointer to default logging function
2668  * \param[in]  clear_func        pointer to substructures free function
2669  * \param[in]  size              sizeof structure
2670  * \param[in]  type_flag         mask associated with field types with which
2671  *                               the key may be associated, or 0
2672  *
2673  * \return  id associated with key
2674  */
2675 /*----------------------------------------------------------------------------*/
2676 
2677 int
cs_field_define_key_struct(const char * name,const void * default_value,cs_field_log_key_struct_t * log_func,cs_field_log_key_struct_t * log_func_default,cs_field_clear_key_struct_t * clear_func,size_t size,int type_flag)2678 cs_field_define_key_struct(const char                   *name,
2679                            const void                   *default_value,
2680                            cs_field_log_key_struct_t    *log_func,
2681                            cs_field_log_key_struct_t    *log_func_default,
2682                            cs_field_clear_key_struct_t  *clear_func,
2683                            size_t                        size,
2684                            int                           type_flag)
2685 {
2686   int n_keys_init = _n_keys;
2687 
2688   int key_id = _find_or_add_key(name);
2689 
2690   cs_field_key_def_t *kd = _key_defs + key_id;
2691 
2692   /* Free possible previous allocation */
2693   if (n_keys_init == _n_keys)
2694     BFT_FREE(kd->def_val.v_p);
2695 
2696   if (default_value != NULL) {
2697     BFT_MALLOC(kd->def_val.v_p, size, unsigned char);
2698     memcpy(kd->def_val.v_p, default_value, size);
2699   }
2700   else
2701     kd->def_val.v_p = NULL;
2702   kd->log_func = log_func;
2703   kd->log_func_default = log_func_default;
2704   kd->clear_func = clear_func;
2705   kd->type_size = size;
2706   kd->type_flag = type_flag;
2707   kd->type_id = 't';
2708   kd->log_id = 's';
2709   kd->is_sub = false;
2710 
2711   return key_id;
2712 }
2713 
2714 /*----------------------------------------------------------------------------*/
2715 /*!
2716  * \brief Define a sub key.
2717  *
2718  * The sub key is the same type as the parent key.
2719  *
2720  * For a given field, when querying a sub key's value and that value has not
2721  * been set, the query will return the value of the parent key.
2722  *
2723  * \param[in]  name            key name
2724  * \param[in]  parent_id       parent key id
2725  *
2726  * \return  id associated with key
2727  */
2728 /*----------------------------------------------------------------------------*/
2729 
2730 int
cs_field_define_sub_key(const char * name,int parent_id)2731 cs_field_define_sub_key(const char  *name,
2732                         int          parent_id)
2733 {
2734   int key_id = _find_or_add_key(name);
2735 
2736   cs_field_key_def_t *kd = _key_defs + key_id;
2737   cs_field_key_def_t *pkd = _key_defs + parent_id;
2738 
2739   assert(parent_id > -1 && parent_id < _n_keys);
2740 
2741   kd->def_val.v_int = parent_id;
2742   kd->type_flag = pkd->type_flag;
2743   kd->type_id = pkd->type_id;
2744   kd->log_id = pkd->log_id;
2745   kd->is_sub = true;
2746 
2747   return key_id;
2748 }
2749 
2750 /*----------------------------------------------------------------------------*/
2751 /*!
2752  * \brief Destroy all defined field keys and associated values.
2753  */
2754 /*----------------------------------------------------------------------------*/
2755 
2756 void
cs_field_destroy_all_keys(void)2757 cs_field_destroy_all_keys(void)
2758 {
2759   int key_id;
2760   for (key_id = 0; key_id < _n_keys; key_id++) {
2761     cs_field_key_def_t *kd = _key_defs + key_id;
2762     if (kd->type_id == 't') {
2763       BFT_FREE(kd->def_val.v_p);
2764     }
2765   }
2766 
2767   _n_keys = 0;
2768   _n_keys_max = 0;
2769   BFT_FREE(_key_defs);
2770 
2771   cs_map_name_to_id_destroy(&_key_map);
2772 
2773   BFT_FREE(_key_vals);
2774 }
2775 
2776 /*----------------------------------------------------------------------------*/
2777 /*!
2778  * \brief Get the type flag associated with a given key id.
2779  *
2780  * If the key has not been defined previously, -1 is returned.
2781  *
2782  * \param[in]  key_id  id of associated key
2783  *
2784  * \return  type flag associated with key, or -1
2785  */
2786 /*----------------------------------------------------------------------------*/
2787 
2788 int
cs_field_key_flag(int key_id)2789 cs_field_key_flag(int key_id)
2790 {
2791   int retval = -1;
2792 
2793   if (key_id > -1) {
2794     cs_field_key_def_t *kd = _key_defs + key_id;
2795     retval = kd->type_flag;
2796   }
2797 
2798   return retval;
2799 }
2800 
2801 /*----------------------------------------------------------------------------*/
2802 /*!
2803  * \brief Disable logging setup values associated with a given key.
2804  *
2805  * This is useful when a key is used not for setup purposes, but to track
2806  * values associated with a field, such as convergence or performance data.
2807  *
2808  * \param[in]  key_id  id of associated key
2809  */
2810 /*----------------------------------------------------------------------------*/
2811 
2812 void
cs_field_key_disable_setup_log(int key_id)2813 cs_field_key_disable_setup_log(int  key_id)
2814 {
2815   assert(key_id >= 0 && key_id < _n_keys);
2816   cs_field_key_def_t *kd = _key_defs + key_id;
2817   kd->log_id = 'n';
2818 }
2819 
2820 /*----------------------------------------------------------------------------*/
2821 /*!
2822  * \brief Query if a given key has been set for a field.
2823  *
2824  * If the key id is not valid, or the field category is not
2825  * compatible, a fatal error is provoked.
2826  *
2827  * \param[in]  f       pointer to field structure
2828  * \param[in]  key_id  id of associated key
2829  *
2830  * \return  true if the key has been set for this field, false otherwise
2831  */
2832 /*----------------------------------------------------------------------------*/
2833 
2834 bool
cs_field_is_key_set(const cs_field_t * f,int key_id)2835 cs_field_is_key_set(const cs_field_t  *f,
2836                     int                key_id)
2837 {
2838   int errcode = _check_key(f, key_id);
2839 
2840   if (errcode == CS_FIELD_OK) {
2841     cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
2842     bool retval = false;
2843     if (kv->is_set)
2844       retval = true;
2845     return retval;
2846   }
2847 
2848   return false;
2849 }
2850 
2851 /*----------------------------------------------------------------------------*/
2852 /*!
2853  * \brief Query if a given key has been locked for a field.
2854  *
2855  * If the key id is not valid, or the field category is not
2856  * compatible, a fatal error is provoked.
2857  *
2858  * \param[in]  f       pointer to field structure
2859  * \param[in]  key_id  id of associated key
2860  *
2861  * \return  true if the key has been locked for this field, false otherwise
2862  */
2863 /*----------------------------------------------------------------------------*/
2864 
2865 bool
cs_field_is_key_locked(const cs_field_t * f,int key_id)2866 cs_field_is_key_locked(const cs_field_t  *f,
2867                        int                key_id)
2868 {
2869   int errcode = _check_key(f, key_id);
2870 
2871   if (errcode == CS_FIELD_OK) {
2872     cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
2873     bool retval = false;
2874     if (kv->is_locked)
2875       retval = true;
2876     return retval;
2877   }
2878 
2879   return false;
2880 }
2881 
2882 /*----------------------------------------------------------------------------*/
2883 /*!
2884  * \brief Lock a field relative to a given key.
2885  *
2886  * If the key id is not valid, CS_FIELD_INVALID_KEY_ID is returned.
2887  * If the field category is not compatible with the key (as defined
2888  * by its type flag), CS_FIELD_INVALID_CATEGORY is returned.
2889  *
2890  * \param[in]  f       pointer to field structure
2891  * \param[in]  key_id  id of associated key
2892  *
2893  * \return  0 in case of success, > 1 in case of error
2894  */
2895 /*----------------------------------------------------------------------------*/
2896 
2897 int
cs_field_lock_key(cs_field_t * f,int key_id)2898 cs_field_lock_key(cs_field_t  *f,
2899                   int          key_id)
2900 {
2901   int retval = CS_FIELD_OK;
2902 
2903   if (f == NULL)
2904     return CS_FIELD_INVALID_FIELD;
2905 
2906   assert(f->id >= 0 && f->id < _n_fields);
2907 
2908   if (key_id > -1) {
2909     cs_field_key_def_t *kd = _key_defs + key_id;
2910     assert(key_id < _n_keys);
2911     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
2912       retval = CS_FIELD_INVALID_CATEGORY;
2913     else {
2914       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
2915       kv->is_locked = 1;
2916     }
2917   }
2918   else
2919     retval = CS_FIELD_INVALID_KEY_ID;
2920 
2921   return retval;
2922 }
2923 
2924 /*----------------------------------------------------------------------------*/
2925 /*!
2926  * \brief Assign a integer value for a given key to a field.
2927  *
2928  * If the key id is not valid, CS_FIELD_INVALID_KEY_ID is returned.
2929  * If the field category is not compatible with the key (as defined
2930  * by its type flag), CS_FIELD_INVALID_CATEGORY is returned.
2931  * If the data type does not match, CS_FIELD_INVALID_TYPE is returned.
2932  * If the key value has been locked, CS_FIELD_LOCKED is returned.
2933  *
2934  * \param[in]  f       pointer to field structure
2935  * \param[in]  key_id  id of associated key
2936  * \param[in]  value   value associated with key
2937  *
2938  * \return  0 in case of success, > 1 in case of error
2939  */
2940 /*----------------------------------------------------------------------------*/
2941 
2942 int
cs_field_set_key_int(cs_field_t * f,int key_id,int value)2943 cs_field_set_key_int(cs_field_t  *f,
2944                      int          key_id,
2945                      int          value)
2946 {
2947   int retval = CS_FIELD_OK;
2948 
2949   if (f == NULL)
2950     return CS_FIELD_INVALID_FIELD;
2951   assert(f->id >= 0 && f->id < _n_fields);
2952 
2953   if (key_id > -1) {
2954     cs_field_key_def_t *kd = _key_defs + key_id;
2955     assert(key_id < _n_keys);
2956     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
2957       retval = CS_FIELD_INVALID_CATEGORY;
2958     else if (kd->type_id != 'i')
2959       retval = CS_FIELD_INVALID_TYPE;
2960     else {
2961       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
2962       if (kv->is_locked)
2963         retval = CS_FIELD_LOCKED;
2964       else {
2965         kv->val.v_int = value;
2966         kv->is_set = 1;
2967       }
2968     }
2969   }
2970   else
2971     retval = CS_FIELD_INVALID_KEY_ID;
2972 
2973   return retval;
2974 }
2975 
2976 /*----------------------------------------------------------------------------*/
2977 /*!
2978  * \brief Return a integer value for a given key associated with a field.
2979  *
2980  * If the key id is not valid, or the value type or field category is not
2981  * compatible, a fatal error is provoked.
2982  *
2983  * \param[in]  f       pointer to field structure
2984  * \param[in]  key_id  id of associated key
2985  *
2986  * \return  integer value associated with the key id for this field
2987  */
2988 /*----------------------------------------------------------------------------*/
2989 
2990 int
cs_field_get_key_int(const cs_field_t * f,int key_id)2991 cs_field_get_key_int(const cs_field_t  *f,
2992                      int                key_id)
2993 {
2994   int errcode = CS_FIELD_OK;
2995 
2996   if (f == NULL)
2997     return CS_FIELD_INVALID_FIELD;
2998   assert(f->id >= 0 && f->id < _n_fields);
2999 
3000   if (key_id > -1 && key_id < _n_keys) {
3001     cs_field_key_def_t *kd = _key_defs + key_id;
3002     assert(key_id < _n_keys);
3003     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
3004       errcode = CS_FIELD_INVALID_CATEGORY;
3005     else if (kd->type_id != 'i')
3006       errcode = CS_FIELD_INVALID_TYPE;
3007     else {
3008       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
3009       int retval = 0;
3010       if (kv->is_set)
3011         retval = kv->val.v_int;
3012       else if (kd->is_sub)
3013         retval = cs_field_get_key_int(f, kd->def_val.v_int);
3014       else
3015         retval = kd->def_val.v_int;
3016       return retval;
3017     }
3018   }
3019   else
3020     errcode = CS_FIELD_INVALID_KEY_ID;
3021 
3022   if (errcode != CS_FIELD_OK) {
3023     const char *key = cs_map_name_to_id_reverse(_key_map, key_id);
3024     if (errcode == CS_FIELD_INVALID_CATEGORY)
3025       bft_error(__FILE__, __LINE__, 0,
3026                 _("Field \"%s\" with type flag %d\n"
3027                   "has no value associated with key %d (\"%s\")."),
3028                 f->name, f->type, key_id, key);
3029     else if (errcode == CS_FIELD_INVALID_TYPE)
3030       bft_error(__FILE__, __LINE__, 0,
3031                 _("Field \"%s\" has keyword %d (\"%s\")\n"
3032                   "of type \"%c\" and not \"%c\"."),
3033                 f->name, key_id, key, (_key_defs + key_id)->type_id, 'i');
3034     else
3035       bft_error(__FILE__, __LINE__, 0,
3036                 _("Field keyword with id %d is not defined."),
3037                 key_id);
3038   }
3039 
3040   return CS_FIELD_OK;
3041 }
3042 
3043 /*----------------------------------------------------------------------------*/
3044 /*!
3045  * \brief Set integer bits matching a mask to 1 for a given key for a field.
3046  *
3047  * If the key id is not valid, CS_FIELD_INVALID_KEY_ID is returned.
3048  * If the field category is not compatible with the key (as defined
3049  * by its type flag), CS_FIELD_INVALID_CATEGORY is returned.
3050  * If the data type does not match, CS_FIELD_INVALID_TYPE is returned.
3051  * If the key value has been locked, CS_FIELD_LOCKED is returned.
3052  *
3053  * \param[in]  f       pointer to field structure
3054  * \param[in]  key_id  id of associated key
3055  * \param[in]  mask    mask associated with key
3056  *
3057  * \return  0 in case of success, > 1 in case of error
3058  */
3059 /*----------------------------------------------------------------------------*/
3060 
3061 int
cs_field_set_key_int_bits(cs_field_t * f,int key_id,int mask)3062 cs_field_set_key_int_bits(cs_field_t  *f,
3063                           int          key_id,
3064                           int          mask)
3065 {
3066   int value = cs_field_get_key_int(f, key_id);
3067 
3068   value |= mask;
3069 
3070   int retval = cs_field_set_key_int(f, key_id, value);
3071   return retval;
3072 }
3073 
3074 /*----------------------------------------------------------------------------*/
3075 /*!
3076  * \brief Set integer bits matching a mask to 0 for a given key for a field.
3077  *
3078  * If the key id is not valid, CS_FIELD_INVALID_KEY_ID is returned.
3079  * If the field category is not compatible with the key (as defined
3080  * by its type flag), CS_FIELD_INVALID_CATEGORY is returned.
3081  * If the data type does not match, CS_FIELD_INVALID_TYPE is returned.
3082  * If the key value has been locked, CS_FIELD_LOCKED is returned.
3083  *
3084  * \param[in]  f       pointer to field structure
3085  * \param[in]  key_id  id of associated key
3086  * \param[in]  mask    mask associated with key
3087  *
3088  * \return  0 in case of success, > 1 in case of error
3089  */
3090 /*----------------------------------------------------------------------------*/
3091 
3092 int
cs_field_clear_key_int_bits(cs_field_t * f,int key_id,int mask)3093 cs_field_clear_key_int_bits(cs_field_t  *f,
3094                             int          key_id,
3095                             int          mask)
3096 {
3097   int value = cs_field_get_key_int(f, key_id);
3098 
3099   value |= mask;
3100   value -= mask;
3101 
3102   int retval = cs_field_set_key_int(f, key_id, value);
3103   return retval;
3104 }
3105 
3106 /*----------------------------------------------------------------------------*/
3107 /*!
3108  * \brief Assign a floating point value for a given key to a field.
3109  *
3110  * If the key id is not valid, CS_FIELD_INVALID_KEY_ID is returned.
3111  * If the field category is not compatible with the key (as defined
3112  * by its type flag), CS_FIELD_INVALID_CATEGORY is returned.
3113  *
3114  * \param[in]  f       pointer to field structure
3115  * \param[in]  key_id  id of associated key
3116  * \param[in]  value   value associated with key
3117  *
3118  * \return  0 in case of success, > 1 in case of error
3119  */
3120 /*----------------------------------------------------------------------------*/
3121 
3122 int
cs_field_set_key_double(cs_field_t * f,int key_id,double value)3123 cs_field_set_key_double(cs_field_t  *f,
3124                         int          key_id,
3125                         double       value)
3126 {
3127   int retval = CS_FIELD_OK;
3128 
3129   if (f == NULL)
3130     return CS_FIELD_INVALID_FIELD;
3131   assert(f->id >= 0 && f->id < _n_fields);
3132 
3133   if (key_id > -1) {
3134     cs_field_key_def_t *kd = _key_defs + key_id;
3135     assert(key_id < _n_keys);
3136     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
3137       retval = CS_FIELD_INVALID_CATEGORY;
3138     else if (kd->type_id != 'd')
3139       retval = CS_FIELD_INVALID_TYPE;
3140     else {
3141       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
3142       if (kv->is_locked)
3143         retval = CS_FIELD_LOCKED;
3144       else {
3145         kv->val.v_double = value;
3146         kv->is_set = 1;
3147       }
3148     }
3149   }
3150   else
3151     retval = CS_FIELD_INVALID_KEY_ID;
3152 
3153   return retval;
3154 }
3155 
3156 /*----------------------------------------------------------------------------*/
3157 /*!
3158  * \brief Return a floating point value for a given key associated with a field.
3159  *
3160  * If the key id is not valid, or the value type or field category is not
3161  * compatible, a fatal error is provoked.
3162  *
3163  * \param[in]  f       pointer to field structure
3164  * \param[in]  key_id  id of associated key
3165  *
3166  * \return  floating point value associated with the key id for this field
3167  */
3168 /*----------------------------------------------------------------------------*/
3169 
3170 double
cs_field_get_key_double(const cs_field_t * f,int key_id)3171 cs_field_get_key_double(const cs_field_t  *f,
3172                         int                key_id)
3173 {
3174   int errcode = CS_FIELD_OK;
3175 
3176   if (f == NULL)
3177     bft_error(__FILE__, __LINE__, 0,
3178               "%s: Field is not defined.", __func__);
3179   assert(f->id >= 0 && f->id < _n_fields);
3180 
3181   if (key_id > -1 && key_id < _n_keys) {
3182     cs_field_key_def_t *kd = _key_defs + key_id;
3183     assert(key_id < _n_keys);
3184     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
3185       errcode = CS_FIELD_INVALID_CATEGORY;
3186     else if (kd->type_id != 'd')
3187       errcode = CS_FIELD_INVALID_TYPE;
3188     else {
3189       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
3190       double retval = 0.;
3191       if (kv->is_set)
3192         retval = kv->val.v_double;
3193       else if (kd->is_sub)
3194         retval = cs_field_get_key_double(f, kd->def_val.v_int);
3195       else
3196         retval = kd->def_val.v_double;
3197       return retval;
3198     }
3199   }
3200   else
3201     errcode = CS_FIELD_INVALID_KEY_ID;
3202 
3203   if (errcode != CS_FIELD_OK) {
3204     const char *key = cs_map_name_to_id_reverse(_key_map, key_id);
3205     if (errcode == CS_FIELD_INVALID_CATEGORY)
3206       bft_error(__FILE__, __LINE__, 0,
3207                 _("Field %s with type flag %d\n"
3208                   "has no value associated with key %d (%s)."),
3209                 f->name, f->type, key_id, key);
3210     else if (errcode == CS_FIELD_INVALID_TYPE)
3211       bft_error(__FILE__, __LINE__, 0,
3212                 _("Field \"%s\" has keyword %d (\"%s\")\n"
3213                   "of type \"%c\" and not \"%c\"."),
3214                 f->name, key_id, key, (_key_defs + key_id)->type_id, 'd');
3215     else
3216       bft_error(__FILE__, __LINE__, 0,
3217                 _("Field keyword with id %d is not defined."),
3218                 key_id);
3219   }
3220 
3221   return 0.;
3222 }
3223 
3224 /*----------------------------------------------------------------------------*/
3225 /*!
3226  * \brief Assign a character string for a given key to a field.
3227  *
3228  * If the key id is not valid, CS_FIELD_INVALID_KEY_ID is returned.
3229  * If the field category is not compatible with the key (as defined
3230  * by its type flag), CS_FIELD_INVALID_CATEGORY is returned.
3231  *
3232  * \param[in]  f       pointer to field structure
3233  * \param[in]  key_id  id of associated key
3234  * \param[in]  str     string associated with key
3235  *
3236  * \return  0 in case of success, > 1 in case of error
3237  */
3238 /*----------------------------------------------------------------------------*/
3239 
3240 int
cs_field_set_key_str(cs_field_t * f,int key_id,const char * str)3241 cs_field_set_key_str(cs_field_t  *f,
3242                      int          key_id,
3243                      const char  *str)
3244 {
3245   int retval = CS_FIELD_OK;
3246 
3247   if (f == NULL)
3248     return CS_FIELD_INVALID_FIELD;
3249   assert(f->id >= 0 && f->id < _n_fields);
3250 
3251   if (key_id > -1) {
3252     cs_field_key_def_t *kd = _key_defs + key_id;
3253     assert(key_id < _n_keys);
3254     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
3255       retval = CS_FIELD_INVALID_CATEGORY;
3256     else if (kd->type_id != 's')
3257       retval = CS_FIELD_INVALID_TYPE;
3258     else {
3259       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
3260       if (kv->is_locked)
3261         retval = CS_FIELD_LOCKED;
3262       else {
3263         if (kv->is_set == 0)
3264           kv->val.v_p = NULL;
3265         BFT_REALLOC(kv->val.v_p, strlen(str) + 1, char);
3266         strcpy(kv->val.v_p, str);
3267         kv->is_set = 1;
3268       }
3269     }
3270   }
3271   else
3272     retval = CS_FIELD_INVALID_KEY_ID;
3273 
3274   return retval;
3275 }
3276 
3277 /*----------------------------------------------------------------------------*/
3278 /*!
3279  * \brief Return a string for a given key associated with a field.
3280  *
3281  * If the key id is not valid, or the value type or field category is not
3282  * compatible, a fatal error is provoked.
3283  *
3284  * \param[in]  f       pointer to field structure
3285  * \param[in]  key_id  id of associated key
3286  *
3287  * \return  pointer to character string associated with
3288  *          the key id for this field
3289  */
3290 /*----------------------------------------------------------------------------*/
3291 
3292 const char *
cs_field_get_key_str(const cs_field_t * f,int key_id)3293 cs_field_get_key_str(const cs_field_t  *f,
3294                      int                key_id)
3295 {
3296   int errcode = CS_FIELD_OK;
3297 
3298   if (f == NULL)
3299     return NULL;
3300   assert(f->id >= 0 && f->id < _n_fields);
3301 
3302   if (key_id > -1 && key_id < _n_keys) {
3303     cs_field_key_def_t *kd = _key_defs + key_id;
3304     assert(key_id < _n_keys);
3305     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
3306       errcode = CS_FIELD_INVALID_CATEGORY;
3307     else if (kd->type_id != 's')
3308       errcode = CS_FIELD_INVALID_TYPE;
3309     else {
3310       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
3311       const char *str = NULL;
3312       if (kv->is_set)
3313         str = kv->val.v_p;
3314       else if (kd->is_sub)
3315         str = cs_field_get_key_str(f, kd->def_val.v_int);
3316       else
3317         str = kd->def_val.v_p;
3318       return str;
3319     }
3320   }
3321   else
3322     errcode = CS_FIELD_INVALID_KEY_ID;
3323 
3324   if (errcode != CS_FIELD_OK) {
3325     const char *key = cs_map_name_to_id_reverse(_key_map, key_id);
3326     if (errcode == CS_FIELD_INVALID_CATEGORY)
3327       bft_error(__FILE__, __LINE__, 0,
3328                 _("Field \"%s\" with type flag %d\n"
3329                   "has no value associated with key %d (\"%s\")."),
3330                 f->name, f->type, key_id, key);
3331     else if (errcode == CS_FIELD_INVALID_TYPE)
3332       bft_error(__FILE__, __LINE__, 0,
3333                 _("Field \"%s\" has keyword %d (\"%s\")\n"
3334                   "of type \"%c\" and not \"%c\"."),
3335                 f->name, key_id, key, (_key_defs + key_id)->type_id, 'i');
3336     else
3337       bft_error(__FILE__, __LINE__, 0,
3338                 _("Field keyword with id %d is not defined."),
3339                 key_id);
3340   }
3341 
3342   return NULL;
3343 }
3344 
3345 /*----------------------------------------------------------------------------*/
3346 /*!
3347  * \brief Assign a simple structure for a given key to a field.
3348  *
3349  * If the key id is not valid, CS_FIELD_INVALID_KEY_ID is returned.
3350  * If the field category is not compatible with the key (as defined
3351  * by its type flag), CS_FIELD_INVALID_CATEGORY is returned.
3352  *
3353  * \param[in]  f       pointer to field structure
3354  * \param[in]  key_id  id of associated key
3355  * \param[in]  s       structure associated with key
3356  *
3357  * \return  0 in case of success, > 1 in case of error
3358  */
3359 /*----------------------------------------------------------------------------*/
3360 
3361 int
cs_field_set_key_struct(cs_field_t * f,int key_id,void * s)3362 cs_field_set_key_struct(cs_field_t  *f,
3363                         int          key_id,
3364                         void        *s)
3365 {
3366   int retval = CS_FIELD_OK;
3367 
3368   if (f == NULL)
3369     return CS_FIELD_INVALID_FIELD;
3370   assert(f->id >= 0 && f->id < _n_fields);
3371 
3372   if (key_id > -1) {
3373     cs_field_key_def_t *kd = _key_defs + key_id;
3374     assert(key_id < _n_keys);
3375     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
3376       retval = CS_FIELD_INVALID_CATEGORY;
3377     else if (kd->type_id != 't')
3378       retval = CS_FIELD_INVALID_TYPE;
3379     else {
3380       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
3381       if (kv->is_locked)
3382         retval = CS_FIELD_LOCKED;
3383       else {
3384         if (kv->is_set == 0)
3385           BFT_MALLOC(kv->val.v_p, kd->type_size, unsigned char);
3386         memcpy(kv->val.v_p, s, kd->type_size);
3387         kv->is_set = 1;
3388       }
3389     }
3390   }
3391   else
3392     retval = CS_FIELD_INVALID_KEY_ID;
3393 
3394   return retval;
3395 }
3396 
3397 /*----------------------------------------------------------------------------*/
3398 /*!
3399  * \brief Return a structure for a given key associated with a field.
3400  *
3401  * If the key id is not valid, or the value type or field category is not
3402  * compatible, a fatal error is provoked.
3403  *
3404  * \param[in]   f       pointer to field structure
3405  * \param[in]   key_id  id of associated key
3406  * \param[out]  s       structure associated with key
3407  *
3408  * \return  pointer to structure associated with
3409  *          the key id for this field (same as s)
3410  */
3411 /*----------------------------------------------------------------------------*/
3412 
3413 const void *
cs_field_get_key_struct(const cs_field_t * f,const int key_id,void * s)3414 cs_field_get_key_struct(const cs_field_t  *f,
3415                         const int          key_id,
3416                         void              *s)
3417 {
3418   if (f == NULL)
3419     return NULL;
3420   assert(f->id >= 0 && f->id < _n_fields);
3421 
3422   int errcode = CS_FIELD_OK;
3423 
3424   if (key_id > -1 && key_id < _n_keys) {
3425     cs_field_key_def_t *kd = _key_defs + key_id;
3426     assert(key_id < _n_keys);
3427     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
3428       errcode = CS_FIELD_INVALID_CATEGORY;
3429     else if (kd->type_id != 't')
3430       errcode = CS_FIELD_INVALID_TYPE;
3431     else {
3432       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
3433       const unsigned char *p = NULL;
3434       if (kv->is_set)
3435         p = kv->val.v_p;
3436       else if (kd->is_sub)
3437         p = cs_field_get_key_struct(f, kd->def_val.v_int, s);
3438       else
3439         p = kd->def_val.v_p;
3440       memcpy(s, p, kd->type_size);
3441       return s;
3442     }
3443   }
3444   else
3445     errcode = CS_FIELD_INVALID_KEY_ID;
3446 
3447   if (errcode != CS_FIELD_OK) {
3448     const char *key = cs_map_name_to_id_reverse(_key_map, key_id);
3449     if (errcode == CS_FIELD_INVALID_CATEGORY)
3450       bft_error(__FILE__, __LINE__, 0,
3451                 _("Field \"%s\" with type flag %d\n"
3452                   "has no value associated with key %d (\"%s\")."),
3453                 f->name, f->type, key_id, key);
3454     else if (errcode == CS_FIELD_INVALID_TYPE)
3455       bft_error(__FILE__, __LINE__, 0,
3456                 _("Field \"%s\" has keyword %d (\"%s\")\n"
3457                   "of type \"%c\" and not \"%c\"."),
3458                 f->name, key_id, key, (_key_defs + key_id)->type_id, 'i');
3459     else
3460       bft_error(__FILE__, __LINE__, 0,
3461                 _("Field keyword with id %d is not defined."),
3462                 key_id);
3463   }
3464 
3465   return NULL;
3466 }
3467 
3468 /*----------------------------------------------------------------------------*/
3469 /*!
3470  * \brief Return a pointer to a simple structure for a given key to a field.
3471  *
3472  * If the key id is not valid, the value type or field category is not
3473  * compatible, or the structure has been locked, a fatal error is provoked.
3474  *
3475  * Note that using this function marks the field's value for this structure
3476  * as set, and if no values have been set yet, the structure is set to
3477  * default values.
3478  *
3479  * \param[in]  f       pointer to field structure
3480  * \param[in]  key_id  id of associated key
3481  *
3482  * \return  pointer to key structure in case of success, NULL in case of error
3483  */
3484 /*----------------------------------------------------------------------------*/
3485 
3486 void *
cs_field_get_key_struct_ptr(cs_field_t * f,int key_id)3487 cs_field_get_key_struct_ptr(cs_field_t  *f,
3488                             int          key_id)
3489 {
3490   if (f == NULL)
3491     return NULL;
3492   assert(f->id >= 0 && f->id < _n_fields);
3493 
3494   int errcode = CS_FIELD_OK;
3495 
3496   if (key_id > -1) {
3497     cs_field_key_def_t *kd = _key_defs + key_id;
3498     assert(key_id < _n_keys);
3499     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
3500       errcode = CS_FIELD_INVALID_CATEGORY;
3501     else if (kd->type_id != 't')
3502       errcode = CS_FIELD_INVALID_TYPE;
3503     else {
3504       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
3505       void *p = NULL;
3506       if (kv->is_locked)
3507         errcode = CS_FIELD_LOCKED;
3508       else {
3509         if (kv->is_set == 0) {
3510           BFT_MALLOC(kv->val.v_p, kd->type_size, unsigned char);
3511           cs_field_get_key_struct(f, key_id, kv->val.v_p);
3512         }
3513         p = kv->val.v_p;
3514         kv->is_set = 1;
3515         return p;
3516       }
3517     }
3518   }
3519   else
3520     errcode = CS_FIELD_INVALID_KEY_ID;
3521 
3522   if (errcode != CS_FIELD_OK) {
3523     const char *key = cs_map_name_to_id_reverse(_key_map, key_id);
3524     if (errcode == CS_FIELD_INVALID_CATEGORY)
3525       bft_error(__FILE__, __LINE__, 0,
3526                 _("Field \"%s\" with type flag %d\n"
3527                   "has no value associated with key %d (\"%s\")."),
3528                 f->name, f->type, key_id, key);
3529     else if (errcode == CS_FIELD_INVALID_TYPE)
3530       bft_error(__FILE__, __LINE__, 0,
3531                 _("Field \"%s\" has keyword %d (\"%s\")\n"
3532                   "of type \"%c\" and not \"%c\"."),
3533                 f->name, key_id, key, (_key_defs + key_id)->type_id, 'i');
3534     else if (errcode == CS_FIELD_LOCKED)
3535       bft_error(__FILE__, __LINE__, 0,
3536                 _("Field \"%s\" structure indicated by keyword %d (\"%s\")\n"
3537                   "has been locked.\n"
3538                   "use %s to access instead."),
3539                 f->name, key_id, key, "cs_field_get_key_struct_const_ptr");
3540     else
3541       bft_error(__FILE__, __LINE__, 0,
3542                 _("Field keyword with id %d is not defined."),
3543                 key_id);
3544   }
3545 
3546   return NULL;
3547 }
3548 
3549 /*----------------------------------------------------------------------------*/
3550 /*!
3551  * \brief Return a read-only pointer to a simple structure for a given key
3552  *        to a field.
3553  *
3554  * If the key id is not valid, the value type or field category is not
3555  * compatible, a fatal error is provoked.
3556  *
3557  * \param[in]  f       pointer to field structure
3558  * \param[in]  key_id  id of associated key
3559  *
3560  * \return  pointer to key structure in case of success, NULL in case of error
3561  */
3562 /*----------------------------------------------------------------------------*/
3563 
3564 const void *
cs_field_get_key_struct_const_ptr(const cs_field_t * f,int key_id)3565 cs_field_get_key_struct_const_ptr(const cs_field_t  *f,
3566                                   int                key_id)
3567 {
3568   if (f == NULL)
3569     return NULL;
3570   assert(f->id >= 0 && f->id < _n_fields);
3571 
3572   int errcode = CS_FIELD_OK;
3573 
3574   if (key_id > -1 && key_id < _n_keys) {
3575     cs_field_key_def_t *kd = _key_defs + key_id;
3576     assert(key_id < _n_keys);
3577     if (kd->type_flag != 0 && !(f->type & kd->type_flag))
3578       errcode = CS_FIELD_INVALID_CATEGORY;
3579     else if (kd->type_id != 't')
3580       errcode = CS_FIELD_INVALID_TYPE;
3581     else {
3582       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
3583       const unsigned char *p = NULL;
3584       if (kv->is_set)
3585         p = kv->val.v_p;
3586       else if (kd->is_sub)
3587         p = cs_field_get_key_struct_const_ptr(f, kd->def_val.v_int);
3588       else
3589         p = kd->def_val.v_p;
3590       return p;
3591     }
3592   }
3593   else
3594     errcode = CS_FIELD_INVALID_KEY_ID;
3595 
3596   if (errcode != CS_FIELD_OK) {
3597     const char *key = cs_map_name_to_id_reverse(_key_map, key_id);
3598     if (errcode == CS_FIELD_INVALID_CATEGORY)
3599       bft_error(__FILE__, __LINE__, 0,
3600                 _("Field \"%s\" with type flag %d\n"
3601                   "has no value associated with key %d (\"%s\")."),
3602                 f->name, f->type, key_id, key);
3603     else if (errcode == CS_FIELD_INVALID_TYPE)
3604       bft_error(__FILE__, __LINE__, 0,
3605                 _("Field \"%s\" has keyword %d (\"%s\")\n"
3606                   "of type \"%c\" and not \"%c\"."),
3607                 f->name, key_id, key, (_key_defs + key_id)->type_id, 'i');
3608     else
3609       bft_error(__FILE__, __LINE__, 0,
3610                 _("Field keyword with id %d is not defined."),
3611                 key_id);
3612   }
3613 
3614   return NULL;
3615 }
3616 
3617 /*----------------------------------------------------------------------------*/
3618 /*!
3619  * \brief Print info relative to all field definitions to log file.
3620  */
3621 /*----------------------------------------------------------------------------*/
3622 
3623 void
cs_field_log_defs(void)3624 cs_field_log_defs(void)
3625 {
3626   int i, j, cat_id;
3627 
3628   int n_cat_fields = 0;
3629 
3630   int mask_id_start = 2; /* _type_flag_*[CS_FIELD_VARIABLE] */
3631   int mask_id_end = 7;   /* _type_flag_*[CS_FIELD_CDO] */
3632   int mask_prev = 0;
3633 
3634   if (_n_fields == 0)
3635     return;
3636 
3637   /* Fields by category */
3638 
3639   for (cat_id = mask_id_start; cat_id < mask_id_end + 1; cat_id++) {
3640 
3641     size_t name_width = 24;
3642 
3643     /* First loop to determine name width */
3644 
3645     n_cat_fields = 0;
3646 
3647     for (i = 0; i < _n_fields; i++) {
3648 
3649       const cs_field_t *f = _fields[i];
3650 
3651       if (f->type & mask_prev)
3652         continue;
3653 
3654       size_t l = strlen(f->name);
3655       if (l > name_width)
3656         name_width = l;
3657     }
3658 
3659     if (name_width > 63)
3660       name_width = 63;
3661 
3662     /* Main loop */
3663 
3664     for (i = 0; i < _n_fields; i++) {
3665 
3666       char ilv_c = ' ';
3667 
3668       const cs_field_t *f = _fields[i];
3669 
3670       if (f->type & mask_prev)
3671         continue;
3672 
3673       if (cat_id == mask_id_end || f->type & _type_flag_mask[cat_id]) {
3674 
3675         char tmp_s[4][64] =  {"", "", "", ""};
3676 
3677         /* Print header for first field of each category */
3678 
3679         if (n_cat_fields == 0) {
3680 
3681           cs_log_strpad(tmp_s[0], _("Field"), name_width, 64);
3682           cs_log_strpad(tmp_s[1], _("Dim."), 4, 64);
3683           cs_log_strpad(tmp_s[2], _("Location"), 20, 64);
3684           cs_log_strpad(tmp_s[3], _("Id"), 4, 64);
3685 
3686           /* Print logging header */
3687 
3688           if (cat_id < mask_id_end)
3689             cs_log_printf(CS_LOG_SETUP,
3690                           _("\n"
3691                             "Fields of type: %s\n"
3692                             "---------------\n"), _(_type_flag_name[cat_id]));
3693           else
3694             cs_log_printf(CS_LOG_SETUP,
3695                           _("\n"
3696                             "Other fields:\n"
3697                             "-------------\n"));
3698           cs_log_printf(CS_LOG_SETUP, "\n");
3699 
3700           cs_log_printf(CS_LOG_SETUP, _("  %s %s %s %s Type flag\n"),
3701                         tmp_s[0], tmp_s[1], tmp_s[2], tmp_s[3]);
3702 
3703           for (j = 0; j < 4; j++)
3704             memset(tmp_s[j], '-', 64);
3705 
3706           tmp_s[0][name_width] = '\0';
3707           tmp_s[1][4] = '\0';
3708           tmp_s[2][20] = '\0';
3709           tmp_s[3][4] = '\0';
3710 
3711           cs_log_printf(CS_LOG_SETUP, _("  %s %s %s %s ---------\n"),
3712                         tmp_s[0], tmp_s[1], tmp_s[2], tmp_s[3]);
3713 
3714         }
3715 
3716         /* Print field info */
3717 
3718         cs_log_strpad(tmp_s[0], f->name, name_width, 64);
3719 
3720         cs_log_strpad(tmp_s[1],
3721                       _(cs_mesh_location_get_name(f->location_id)),
3722                       20,
3723                       64);
3724 
3725         cs_log_printf(CS_LOG_SETUP,
3726                       "  %s %d %c  %s %-4d ",
3727                       tmp_s[0], f->dim, ilv_c,
3728                       tmp_s[1],
3729                       f->id);
3730 
3731         if (f->type != 0) {
3732           cs_log_printf(CS_LOG_SETUP, "%-4d", f->type);
3733           _log_add_type_flag(f->type);
3734           cs_log_printf(CS_LOG_SETUP, "\n");
3735         }
3736         else
3737           cs_log_printf(CS_LOG_SETUP, "0\n");
3738 
3739         n_cat_fields++;
3740 
3741       }
3742 
3743     } /* End of loop on fields */
3744 
3745     if (cat_id < mask_id_end)
3746       mask_prev += _type_flag_mask[cat_id];
3747 
3748   } /* End fo loop on categories */
3749 }
3750 
3751 /*----------------------------------------------------------------------------*/
3752 /*!
3753  * \brief Print info relative to a given field to log file.
3754  *
3755  * \param[in]  f             pointer to field structure
3756  * \param[in]  log_keywords  log level for keywords (0: do not log,
3757  *                           1: log non-default values, 2: log all)
3758  */
3759 /*----------------------------------------------------------------------------*/
3760 
3761 void
cs_field_log_info(const cs_field_t * f,int log_keywords)3762 cs_field_log_info(const cs_field_t  *f,
3763                   int                log_keywords)
3764 {
3765   if (f == NULL)
3766     return;
3767 
3768   /* Global indicators */
3769   /*-------------------*/
3770 
3771   cs_log_printf(CS_LOG_SETUP,
3772                 _("\n"
3773                   "  Field: \"%s\"\n"), f->name);
3774 
3775   if (log_keywords > 0)
3776     cs_log_printf(CS_LOG_SETUP, "\n");
3777 
3778   cs_log_printf(CS_LOG_SETUP,
3779                 _("    Id:                         %d\n"
3780                   "    Type:                       %d"), f->id, f->type);
3781 
3782   if (f->type != 0) {
3783     int i;
3784     int n_loc_flags = 0;
3785     for (i = 0; i < _n_type_flags; i++) {
3786       if (f->type & _type_flag_mask[i]) {
3787         if (n_loc_flags == 0)
3788           cs_log_printf(CS_LOG_SETUP, " (%s", _(_type_flag_name[i]));
3789         else
3790           cs_log_printf(CS_LOG_SETUP, ", %s", _(_type_flag_name[i]));
3791         n_loc_flags++;
3792       }
3793     }
3794     if (n_loc_flags > 0)
3795       cs_log_printf(CS_LOG_SETUP, ")");
3796     cs_log_printf(CS_LOG_SETUP, "\n");
3797   }
3798 
3799   cs_log_printf(CS_LOG_SETUP, _("    Location:                   %s\n"),
3800                 cs_mesh_location_get_name(f->location_id));
3801 
3802   if (f->dim == 1)
3803     cs_log_printf(CS_LOG_SETUP, _("    Dimension:                  1\n"));
3804   else
3805     cs_log_printf(CS_LOG_SETUP,
3806                   _("    Dimension:                  %d\n"),
3807                   f->dim);
3808 
3809   if (f->is_owner == false)
3810     cs_log_printf(CS_LOG_SETUP,
3811                   _("    Values mapped from external definition\n"));
3812 
3813   if (_n_keys > 0 && log_keywords > 0) {
3814     int i;
3815     const char null_str[] = "(null)";
3816     cs_log_printf(CS_LOG_SETUP, _("\n    Associated key values:\n"));
3817     for (i = 0; i < _n_keys; i++) {
3818       int key_id = cs_map_name_to_id_try(_key_map,
3819                                          cs_map_name_to_id_key(_key_map, i));
3820       cs_field_key_def_t *kd = _key_defs + key_id;
3821       if (kd->log_id != 's')
3822         continue;
3823       cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
3824       const char *key = cs_map_name_to_id_key(_key_map, i);
3825       if (kd->type_flag == 0 || (kd->type_flag & f->type)) {
3826         if (kd->type_id == 'i') {
3827           if (kv->is_set)
3828             cs_log_printf(CS_LOG_SETUP, _("      %-24s %-10d\n"),
3829                           key, kv->val.v_int);
3830           else if (log_keywords > 1)
3831             cs_log_printf(CS_LOG_SETUP, _("      %-24s %-10d (default)\n"),
3832                           key, kd->def_val.v_int);
3833         }
3834         else if (kd->type_id == 'd') {
3835           if (kv->is_set)
3836             cs_log_printf(CS_LOG_SETUP, _("      %-24s %-10.3g\n"),
3837                           key, kv->val.v_double);
3838           else if (log_keywords > 1)
3839             cs_log_printf(CS_LOG_SETUP, _("      %-24s %-10.3g (default)\n"),
3840                           key, kd->def_val.v_double);
3841         }
3842         else if (kd->type_id == 's') {
3843           const char *s;
3844           if (kv->is_set) {
3845             s = kv->val.v_p;
3846             if (s == NULL)
3847               s = null_str;
3848             cs_log_printf(CS_LOG_SETUP, _("      %-24s %-10s\n"), key, s);
3849           }
3850           else if (log_keywords > 1) {
3851             s = kd->def_val.v_p;
3852             if (s == NULL)
3853               s = null_str;
3854             cs_log_printf(CS_LOG_SETUP, _("      %-24s %-10s (default)\n"),
3855                           key, s);
3856           }
3857         }
3858         else if (kd->type_id == 't') {
3859           const void *t;
3860           if (kv->is_set) {
3861             t = kv->val.v_p;
3862             if (kd->log_func != NULL) {
3863               cs_log_printf(CS_LOG_SETUP, _("      %-24s:\n"), key);
3864               kd->log_func(t);
3865             }
3866             else {
3867               cs_log_printf(CS_LOG_SETUP, _("      %-24s %-24p\n"), key, t);
3868             }
3869           }
3870           else if (log_keywords > 1) {
3871             t = kd->def_val.v_p;
3872             if (kd->log_func != NULL) {
3873               cs_log_printf(CS_LOG_SETUP, _("      %-24s: (default)\n"), key);
3874               kd->log_func(t);
3875             }
3876             else
3877               cs_log_printf(CS_LOG_SETUP, _("      %-24s %-24p (default)\n"),
3878                             key, t);
3879           }
3880         }
3881       }
3882     }
3883   }
3884 }
3885 
3886 /*----------------------------------------------------------------------------*/
3887 /*!
3888  * \brief Print info relative to all defined fields to log file.
3889  *
3890  * \param[in]  log_keywords  log level for keywords (0: do not log,
3891  *                           1: log non-default values, 2: log all)
3892  */
3893 /*----------------------------------------------------------------------------*/
3894 
3895 void
cs_field_log_fields(int log_keywords)3896 cs_field_log_fields(int  log_keywords)
3897 {
3898   int i, cat_id;
3899   const cs_field_t  *f;
3900 
3901   int n_cat_fields = 0;
3902 
3903   int mask_id_start = 2; /* _type_flag_*[CS_FIELD_VARIABLE] */
3904   int mask_id_end = 6;   /* _type_flag_*[CS_FIELD_USER] */
3905   int mask_prev = 0;
3906 
3907   if (_n_fields == 0)
3908     return;
3909 
3910   /* Fields by category */
3911 
3912   for (cat_id = mask_id_start; cat_id < mask_id_end + 1; cat_id++) {
3913 
3914     n_cat_fields = 0;
3915 
3916     for (i = 0; i < _n_fields; i++) {
3917 
3918       f = _fields[i];
3919 
3920       if (f->type & mask_prev)
3921         continue;
3922 
3923       if (cat_id == mask_id_end || f->type & _type_flag_mask[cat_id]) {
3924 
3925         if (n_cat_fields == 0) {
3926           if (cat_id < mask_id_end)
3927             cs_log_printf(CS_LOG_SETUP,
3928                           _("\n"
3929                             "Fields of type: %s\n"
3930                             "---------------\n"), _(_type_flag_name[cat_id]));
3931           else
3932             cs_log_printf(CS_LOG_SETUP,
3933                           _("\n"
3934                             "Other fields:\n"
3935                             "-------------\n"));
3936         }
3937         cs_field_log_info(f, log_keywords);
3938         n_cat_fields++;
3939 
3940       }
3941 
3942     } /* End of loop on fields */
3943 
3944     if (cat_id < mask_id_end)
3945       mask_prev += _type_flag_mask[cat_id];
3946 
3947   } /* End of loop on categories */
3948 }
3949 
3950 /*----------------------------------------------------------------------------*/
3951 /*!
3952  * \brief Print info relative to all key definitions to log file.
3953  */
3954 /*----------------------------------------------------------------------------*/
3955 
3956 void
cs_field_log_key_defs(void)3957 cs_field_log_key_defs(void)
3958 {
3959   int i;
3960   char tmp_s[4][64] =  {"", "", "", ""};
3961 
3962   if (_n_keys == 0)
3963     return;
3964 
3965   /* Print logging header */
3966 
3967   cs_log_strpad(tmp_s[0], _("Key"), 24, 64);
3968   cs_log_strpad(tmp_s[1], _("Default"), 12, 64);
3969   cs_log_strpad(tmp_s[2], _("Type"), 7, 64);
3970   cs_log_strpad(tmp_s[3], _("Id"), 4, 64);
3971 
3972   cs_log_printf(CS_LOG_SETUP,
3973                 _("\n"
3974                   "Defined field keys:\n"
3975                   "-------------------\n\n"));
3976   cs_log_printf(CS_LOG_SETUP, _("  %s %s %s %s Type flag\n"),
3977                 tmp_s[0], tmp_s[1], tmp_s[2], tmp_s[3]);
3978 
3979   for (i = 0; i < 24; i++)
3980     tmp_s[0][i] = '-';
3981   tmp_s[0][24] = '\0';
3982   for (i = 0; i < 12; i++)
3983     tmp_s[1][i] = '-';
3984   tmp_s[1][12] = '\0';
3985   for (i = 0; i < 7; i++)
3986     tmp_s[2][i] = '-';
3987   tmp_s[2][7] = '\0';
3988   for (i = 0; i < 4; i++)
3989     tmp_s[3][i] = '-';
3990   tmp_s[3][4] = '\0';
3991 
3992   cs_log_printf(CS_LOG_SETUP, _("  %s %s %s %s ---------\n"),
3993                 tmp_s[0], tmp_s[1], tmp_s[2], tmp_s[3]);
3994 
3995   /* First loop on keys except structures */
3996 
3997   for (i = 0; i < _n_keys; i++) {
3998 
3999     int key_id = cs_map_name_to_id_try(_key_map,
4000                                        cs_map_name_to_id_key(_key_map, i));
4001     cs_field_key_def_t *kd = _key_defs + key_id;
4002     const char *key = cs_map_name_to_id_key(_key_map, i);
4003 
4004     if (kd->type_id == 'i') {
4005       cs_log_printf(CS_LOG_SETUP,
4006                     _("  %-24s %-12d integer %-4d "),
4007                     key, kd->def_val.v_int, key_id);
4008     }
4009     else if (kd->type_id == 'd') {
4010       cs_log_printf(CS_LOG_SETUP,
4011                     _("  %-24s %-12.3g real    %-4d "),
4012                     key, kd->def_val.v_double, key_id);
4013     }
4014     else if (kd->type_id == 's') {
4015       cs_log_printf(CS_LOG_SETUP,
4016                     _("  %-24s %-12s string  %-4d "),
4017                     key, (char *)(kd->def_val.v_p), key_id);
4018     }
4019     if (kd->type_id != 't') {
4020       if (kd->type_flag == 0)
4021         cs_log_printf(CS_LOG_SETUP, "0\n");
4022       else {
4023         cs_log_printf(CS_LOG_SETUP, "%-4d", kd->type_flag);
4024         _log_add_type_flag(kd->type_flag);
4025         cs_log_printf(CS_LOG_SETUP, "\n");
4026       }
4027     }
4028 
4029   } /* End of loop on keys */
4030 
4031   /* Second loop on keys structures */
4032 
4033   for (i = 0; i < _n_keys; i++) {
4034 
4035     int key_id = cs_map_name_to_id_try(_key_map,
4036                                        cs_map_name_to_id_key(_key_map, i));
4037     cs_field_key_def_t *kd = _key_defs + key_id;
4038     const char *key = cs_map_name_to_id_key(_key_map, i);
4039 
4040     if (kd->type_id == 't') {
4041       cs_log_printf(CS_LOG_SETUP,
4042                     _("  %-24s %-12s struct  %-4d "),
4043                     key, " ", key_id);
4044 
4045       if (kd->type_flag == 0)
4046         cs_log_printf(CS_LOG_SETUP, "0\n");
4047       else {
4048         cs_log_printf(CS_LOG_SETUP, "%-4d", kd->type_flag);
4049         _log_add_type_flag(kd->type_flag);
4050         cs_log_printf(CS_LOG_SETUP, "\n");
4051       }
4052     }
4053   } /* End of loop on keys */
4054 
4055   /* Third loop on keys structures for default values printing */
4056 
4057   char tmp_str[2][64] =  {"", ""};
4058 
4059   /* Print logging header */
4060 
4061   cs_log_strpad(tmp_str[0], _("Key"), 24, 64);
4062   cs_log_strpad(tmp_str[1], _("Default"), 12, 64);
4063 
4064   cs_log_printf(CS_LOG_SETUP,
4065                 _("\n"
4066                   "Default values for structure keys:\n"
4067                   "----------------------------------\n\n"));
4068   cs_log_printf(CS_LOG_SETUP, _("  %s %s Description\n"),
4069                 tmp_str[0], tmp_str[1]);
4070 
4071   for (i = 0; i < 24; i++)
4072     tmp_str[0][i] = '-';
4073   tmp_str[0][24] = '\0';
4074   for (i = 0; i < 12; i++)
4075     tmp_str[1][i] = '-';
4076   tmp_str[1][12] = '\0';
4077 
4078   cs_log_printf(CS_LOG_SETUP, _("  %s %s -----------------------------------------\n"),
4079                 tmp_str[0], tmp_str[1]);
4080 
4081   for (i = 0; i < _n_keys; i++) {
4082 
4083     int key_id = cs_map_name_to_id_try(_key_map,
4084                                        cs_map_name_to_id_key(_key_map, i));
4085     cs_field_key_def_t *kd = _key_defs + key_id;
4086     const void *t;
4087 
4088     if (kd->type_id == 't') {
4089       t = kd->def_val.v_p;
4090 
4091       if (kd->log_func_default != NULL)
4092         kd->log_func_default(t);
4093     }
4094 
4095   } /* End of loop on keys */
4096 
4097 }
4098 
4099 /*----------------------------------------------------------------------------*/
4100 /*!
4101  * \brief Print info relative to a given field key to log file.
4102  *
4103  * \param[in]  key_id        id of associated key
4104  * \param[in]  log_defaults  if true, log default field values in addition to
4105  *                           defined field values
4106  */
4107 /*----------------------------------------------------------------------------*/
4108 
4109 void
cs_field_log_key_vals(int key_id,bool log_defaults)4110 cs_field_log_key_vals(int   key_id,
4111                       bool  log_defaults)
4112 {
4113   int i, cat_id;
4114   cs_field_key_def_t *kd;
4115 
4116   int mask_id_start = 2; /* _type_flag_*[CS_FIELD_VARIABLE] */
4117   int mask_id_end = 6;   /* _type_flag_*[CS_FIELD_USER] */
4118   int mask_prev = 0;
4119   const char null_str[] = "(null)";
4120 
4121   if (key_id < 0 || key_id >= _n_keys)
4122     return;
4123 
4124   kd = _key_defs + key_id;
4125 
4126   /* First loop to determine field width */
4127 
4128   size_t name_width = 24;
4129 
4130   for (i = 0; i < _n_fields; i++) {
4131     const cs_field_t *f = _fields[i];
4132     size_t l = strlen(f->name);
4133     if (l > name_width)
4134       name_width = l;
4135   }
4136   if (name_width > 63)
4137     name_width = 63;
4138 
4139   /* Global indicators */
4140   /*-------------------*/
4141 
4142   cs_log_printf(CS_LOG_SETUP,
4143                 _("\n"
4144                   "  Key: \"%s\", values per field\n"
4145                   "  ----\n"),
4146                 cs_map_name_to_id_reverse(_key_map, key_id));
4147 
4148   /* Loop on categories, building a mask for previous categories
4149      so as not to output data twice */
4150 
4151   for (cat_id = mask_id_start; cat_id < mask_id_end + 1; cat_id++) {
4152 
4153     /* Main loop on fields */
4154 
4155     for (i = 0; i < _n_fields; i++) {
4156 
4157       const cs_field_t *f = _fields[i];
4158 
4159       if (f->type & mask_prev)
4160         continue;
4161 
4162       if (cat_id == mask_id_end || f->type & _type_flag_mask[cat_id]) {
4163 
4164         char name_s[64] =  "";
4165         cs_log_strpad(name_s, f->name, name_width, 64);
4166 
4167         cs_field_key_val_t *kv = _key_vals + (f->id*_n_keys_max + key_id);
4168 
4169         if (kd->type_flag == 0 || (kd->type_flag & f->type)) {
4170           if (kd->type_id == 'i') {
4171             if (kv->is_set)
4172               cs_log_printf(CS_LOG_SETUP, "    %s %d\n",
4173                             name_s, kv->val.v_int);
4174             else if (log_defaults)
4175               cs_log_printf(CS_LOG_SETUP, _("    %s %-10d (default)\n"),
4176                             name_s, kd->def_val.v_int);
4177           }
4178           else if (kd->type_id == 'd') {
4179             if (kv->is_set)
4180               cs_log_printf(CS_LOG_SETUP, _("    %s %-10.3g\n"),
4181                           name_s, kv->val.v_double);
4182             else if (log_defaults)
4183               cs_log_printf(CS_LOG_SETUP, _("    %s %-10.3g (default)\n"),
4184                             name_s, kd->def_val.v_double);
4185           }
4186           else if (kd->type_id == 's') {
4187             const char *s;
4188             if (kv->is_set) {
4189               s = kv->val.v_p;
4190               if (s == NULL)
4191                 s = null_str;
4192               cs_log_printf(CS_LOG_SETUP, _("    %s %s\n"), name_s, s);
4193             }
4194             else if (log_defaults) {
4195               s = kd->def_val.v_p;
4196               if (s == NULL)
4197                 s = null_str;
4198               cs_log_printf(CS_LOG_SETUP, _("    %s %-10s (default)\n"),
4199                             name_s, s);
4200             }
4201           }
4202           else if (kd->type_id == 't') {
4203             if (kv->is_set) {
4204               cs_log_printf(CS_LOG_SETUP, _("\n    %s\n"), name_s);
4205               if (kd->log_func != NULL)
4206                 kd->log_func(kv->val.v_p);
4207             }
4208             else if (log_defaults) {
4209               cs_log_printf(CS_LOG_SETUP, _("\n    %s (default)\n"), name_s);
4210               if (kd->log_func != NULL)
4211                 kd->log_func(kd->def_val.v_p);
4212             }
4213           }
4214         }
4215       }
4216 
4217     }
4218 
4219     if (cat_id < mask_id_end)
4220       mask_prev += _type_flag_mask[cat_id];
4221   }
4222 }
4223 
4224 /*----------------------------------------------------------------------------*/
4225 /*!
4226  * \brief Print info relative to all given field keys to log file.
4227  *
4228  * \param[in]  log_defaults  if true, log default field values in addition to
4229  *                           defined field values
4230  */
4231 /*----------------------------------------------------------------------------*/
4232 
4233 void
cs_field_log_all_key_vals(bool log_defaults)4234 cs_field_log_all_key_vals(bool  log_defaults)
4235 {
4236   int i;
4237 
4238   cs_log_printf(CS_LOG_SETUP,
4239                 _("\n"
4240                   "Defined key values per field:\n"
4241                   "-----------------------------\n\n"));
4242 
4243   for (i = 0; i < _n_keys; i++)
4244     cs_field_log_key_vals(i, log_defaults);
4245 }
4246 
4247 /*----------------------------------------------------------------------------*/
4248 /*!
4249  * \brief Define base keys.
4250  *
4251  * Keys defined by this function are:
4252  *   "label"        (string)
4253  *   "log"          (integer)
4254  *   "post_vis"     (integer)
4255  *   "coupled"      (integer, restricted to CS_FIELD_VARIABLE)
4256  *   "moment_id"    (integer, restricted to
4257  *                   CS_FIELD_ACCUMULATOR | CS_FIELD_POSTPROCESS);
4258  *
4259  * A recommended practice for different submodules would be to use
4260  * "cs_<module>_key_init() functions to define keys specific to those modules.
4261  */
4262 /*----------------------------------------------------------------------------*/
4263 
4264 void
cs_field_define_keys_base(void)4265 cs_field_define_keys_base(void)
4266 {
4267   cs_field_define_key_str("label", NULL, 0);
4268   _k_label = cs_field_key_id("label");
4269 
4270   cs_field_define_key_int("log", 0, 0);
4271   cs_field_define_key_int("post_vis", 0, 0);
4272   cs_field_define_key_int("coupled", 0, CS_FIELD_VARIABLE);
4273   cs_field_define_key_int("moment_id", -1,
4274                           CS_FIELD_ACCUMULATOR | CS_FIELD_POSTPROCESS);
4275 }
4276 
4277 /*----------------------------------------------------------------------------*/
4278 /*!
4279  * \brief Return a label associated with a field.
4280  *
4281  * If the "label" key has been set for this field, its associated string
4282  * is returned. Otherwise, the field's name is returned.
4283  *
4284  * \param[in]  f       pointer to field structure
4285  *
4286  * \return  pointer to character string associated with label for this field
4287  */
4288 /*----------------------------------------------------------------------------*/
4289 
4290 const char *
cs_field_get_label(const cs_field_t * f)4291 cs_field_get_label(const cs_field_t  *f)
4292 {
4293   const char *label = cs_field_get_key_str(f, _k_label);
4294 
4295   if (label == NULL)
4296     label = f->name;
4297 
4298   return label;
4299 }
4300 
4301 /*----------------------------------------------------------------------------*/
4302 
4303 END_C_DECLS
4304