1/*********************************************************************
2 *   Copyright 1993, UCAR/Unidata
3 *   See netcdf/COPYRIGHT file for copying and redistribution conditions.
4 *   $Id: load.c,v 1.35 2009/11/17 18:15:08 dmh Exp $
5 *********************************************************************/
6
7#include "config.h"
8#include <stdio.h>
9#include <stdlib.h>
10#include <string.h>
11#include <ctype.h>
12#include <assert.h>
13#include <netcdf.h>
14#include "generic.h"
15#include "ncgen.h"
16#include "genlib.h"
17
18#ifndef HAVE_STRLCAT
19extern size_t strlcat(char *dst, const char *src, size_t siz);
20#endif
21
22extern int netcdf_flag;
23extern int c_flag;
24extern int fortran_flag;
25
26#define MIN(a,b) (((a) < (b)) ? (a) : (b))
27#define MAX(a,b) (((a) > (b)) ? (a) : (b))
28#define fpr    (void) fprintf
29
30
31/*
32 * Remove trailing zeros (after decimal point) but not trailing decimal
33 * point from ss, a string representation of a floating-point number that
34 * might include an exponent part.
35 */
36static void
37tztrim(
38    char *ss /* returned string representing dd */
39    )
40{
41    char *cp, *ep;
42
43    cp = ss;
44    if (*cp == '-')
45      cp++;
46    while(isdigit((int)*cp) || *cp == '.')
47      cp++;
48    if (*--cp == '.')
49      return;
50    ep = cp+1;
51    while (*cp == '0')
52      cp--;
53    cp++;
54    if (cp == ep)
55      return;
56    while (*ep)
57      *cp++ = *ep++;
58    *cp = '\0';
59    return;
60}
61
62
63/* generate C to put netCDF record from in-memory data */
64static void
65gen_load_c(
66    void *rec_start
67    )
68{
69    int  idimival;
70    char *val_string = NULL;
71    char *charvalp = NULL;
72    short *shortvalp = NULL;
73    int *intvalp = NULL;
74    float *floatvalp = NULL;
75    double *doublevalp = NULL;
76    char stmnt[C_MAX_STMNT];
77    size_t stmnt_len;
78    char s2[C_MAX_STMNT] = {'\0'};
79
80    if (!vars[varnum].has_data)
81 return;
82
83    cline("");
84    sprintf(stmnt, "   {\t\t\t/* store %s */", vars[varnum].name);
85    cline(stmnt);
86
87    if (vars[varnum].ndims > 0) {
88 if (vars[varnum].dims[0] == rec_dim) {
89     sprintf(stmnt, "    static size_t %s_start[RANK_%s];",
90     vars[varnum].lnamevars[varnum].lname);
91     cline(stmnt);
92
93     sprintf(stmnt, "    static size_t %s_count[RANK_%s];",
94     vars[varnum].lnamevars[varnum].lname);
95     cline(stmnt);
96 }
97
98 /* load variable with data values using static initialization */
99 sprintf(stmnt, "    static %s %s[] = {",
100 ncctype(vars[varnum].type),
101 vars[varnum].lname);
102
103 stmnt_len = strlen(stmnt);
104 switch (vars[varnum].type) {
105   case NC_CHAR:
106     val_string = cstrstr((char *) rec_startvar_len);
107     sprintf(s2, "%s", val_string);
108     strlcat(stmnts2C_MAX_STMNT);
109     free(val_string);
110     break;
111   default:
112     switch (vars[varnum].type) {
113       case NC_BYTE:
114 charvalp = (char *) rec_start;
115 break;
116       case NC_SHORT:
117 shortvalp = (short *) rec_start;
118 break;
119       case NC_INT:
120 intvalp = (int *) rec_start;
121 break;
122       case NC_FLOAT:
123 floatvalp = (float *) rec_start;
124 break;
125       case NC_DOUBLE:
126 doublevalp = (double *) rec_start;
127 break;
128       default: break;
129     }
130            for (ival = 0; ival < var_len-1; ival++) {
131 switch (vars[varnum].type) {
132   case NC_BYTE:
133     assert(charvalp != NULL);
134     sprintf(s2, "%d, ", *charvalp++);
135     break;
136   case NC_SHORT:
137     assert(shortvalp != NULL);
138     sprintf(s2, "%d, ", *shortvalp++);
139     break;
140   case NC_INT:
141     assert(intvalp != NULL);
142     sprintf(s2, "%ld, ", (long)*intvalp++);
143     break;
144   case NC_FLOAT:
145     assert(floatvalp != NULL);
146     sprintf(s2, "%.8g, ", *floatvalp++);
147     break;
148   case NC_DOUBLE:
149     assert(doublevalp != NULL);
150     sprintf(s2, "%#.16g", *doublevalp++);
151     tztrim(s2);
152     strcat(s2, ", ");
153     break;
154   default: break;
155 }
156 stmnt_len += strlen(s2);
157 if (stmnt_len < C_MAX_STMNT)
158   strcat(stmnts2);
159 else {
160     cline(stmnt);
161     strcpy(stmnt,s2);
162     stmnt_len = strlen(stmnt);
163 }
164     }
165     for (;ival < var_lenival++) {
166       switch (vars[varnum].type) {
167       case NC_BYTE:
168 assert(charvalp != NULL);
169 sprintf(s2, "%d", *charvalp);
170 break;
171       case NC_SHORT:
172 assert(shortvalp != NULL);
173 sprintf(s2, "%d", *shortvalp);
174 break;
175       case NC_INT:
176 assert(intvalp != NULL);
177 sprintf(s2, "%ld", (long)*intvalp);
178 break;
179       case NC_FLOAT:
180 assert(floatvalp != NULL);
181 sprintf(s2, "%.8g", *floatvalp);
182 break;
183       case NC_DOUBLE:
184 assert(doublevalp != NULL);
185 sprintf(s2, "%#.16g", *doublevalp++);
186 tztrim(s2);
187 break;
188       default: break;
189       }
190       stmnt_len += strlen(s2);
191       if (stmnt_len < C_MAX_STMNT)
192 strcat(stmnts2);
193       else {
194 cline(stmnt);
195 strcpy(stmnt,s2);
196 stmnt_len = strlen(stmnt);
197       }
198     }
199     break;
200 }
201 strcat(stmnt,"};");
202 cline(stmnt);
203
204 if (vars[varnum].dims[0] == rec_dim) {
205     sprintf(stmnt,
206     "    %s_len = %lu; /* number of records of %s data */",
207     dims[rec_dim].lname,
208     (unsigned long)vars[varnum].nrecs, /* number of recs for this variable */
209     vars[varnum].name);
210     cline(stmnt);
211
212     for (idim = 0; idim < vars[varnum].ndimsidim++) {
213 sprintf(stmnt, "    %s_start[%d] = 0;",
214 vars[varnum].lname,
215 idim);
216 cline(stmnt);
217     }
218
219     for (idim = 0; idim < vars[varnum].ndimsidim++) {
220 sprintf(stmnt, "    %s_count[%d] = %s_len;",
221 vars[varnum].lname,
222 idim,
223 dims[vars[varnum].dims[idim]].lname);
224 cline(stmnt);
225     }
226 }
227
228 if (vars[varnum].dims[0] == rec_dim) {
229     sprintf(stmnt,
230     "    stat = nc_put_vara_%s(ncid, %s_id, %s_start, %s_count, %s);",
231     ncstype(vars[varnum].type),
232     vars[varnum].lname,
233     vars[varnum].lname,
234     vars[varnum].lname,
235     vars[varnum].lname);
236 } else { /* non-record variables */
237     sprintf(stmnt,
238     "    stat = nc_put_var_%s(ncid, %s_id, %s);",
239     ncstype(vars[varnum].type),
240     vars[varnum].lname,
241     vars[varnum].lname);
242 }
243 cline(stmnt);
244    } else { /* scalar variables */
245 /* load variable with data values using static initialization */
246 sprintf(stmnt, "    static %s %s = ",
247 ncctype(vars[varnum].type),
248 vars[varnum].lname);
249
250 switch (vars[varnum].type) {
251   case NC_CHAR:
252     val_string = cstrstr((char *) rec_startvar_len);
253     val_string[strlen(val_string)-1] = '\0';
254     sprintf(s2, "'%s'", &val_string[1]);
255     free(val_string);
256     break;
257   case NC_BYTE:
258     charvalp = (char *) rec_start;
259     sprintf(s2, "%d", *charvalp);
260     break;
261   case NC_SHORT:
262     shortvalp = (short *) rec_start;
263     sprintf(s2, "%d", *shortvalp);
264     break;
265   case NC_INT:
266     intvalp = (int *) rec_start;
267     sprintf(s2, "%ld", (long)*intvalp);
268     break;
269   case NC_FLOAT:
270     floatvalp = (float *) rec_start;
271     sprintf(s2, "%.8g", *floatvalp);
272     break;
273   case NC_DOUBLE:
274     doublevalp = (double *) rec_start;
275     sprintf(s2, "%#.16g", *doublevalp++);
276     tztrim(s2);
277     break;
278   default: break;
279 }
280 strlcat(stmnts2C_MAX_STMNT);
281 strlcat(stmnt,";", C_MAX_STMNT);
282 cline(stmnt);
283 sprintf(stmnt,
284 "    stat = nc_put_var_%s(ncid, %s_id, &%s);",
285 ncstype(vars[varnum].type),
286 vars[varnum].lname,
287 vars[varnum].lname);
288 cline(stmnt);
289    }
290    cline("    check_err(stat,__LINE__,__FILE__);");
291    cline("   }");
292}
293
294
295/*
296 * Add to a partial Fortran statement, checking if it's too long.  If it is too
297 * long, output the first part of it as a single statement with continuation
298 * characters and start a new (probably invalid) statement with the remainder.
299 * This will cause a Fortran compiler error, but at least all the information
300 * will be available.
301 */
302static void
303fstrcat(
304    char *s, /* source string of stement being built */
305    const char *t, /* string to be appended to source */
306    size_t *slenp /* pointer to length of source string */
307    )
308{
309
310  *slenp += strlen(t);
311
312  if (*slenp >= FORT_MAX_STMNT) {
313    derror("FORTRAN statement too long: %s",s);
314    fline(s);
315    strncpy(stFORT_MAX_STMNT);
316    *slenp = strlen(s);
317  } else {
318    /* Suppress a coverity-related issue without actually
319       ignoring it in the coverity dashboard. */
320    /* coverity[unsigned_compare] */
321    strncat(stMAX(0,MIN(strlen(t),strlen(s)-(strlen(t)))));
322  }
323}
324
325/*
326 * Create Fortran data statement to initialize numeric variable with
327 * values.
328 */
329static void
330f_var_init(
331    int varnum, /* which variable */
332    void *rec_start /* start of data */
333    )
334{
335    char *val_string;
336    char *charvalp;
337    short *shortvalp;
338    int *intvalp;
339    float *floatvalp;
340    double *doublevalp;
341    char stmnt[FORT_MAX_STMNT];
342    size_t stmnt_len;
343    char s2[FORT_MAX_STMNT];
344    int ival;
345
346    /* load variable with data values  */
347    sprintf(stmnt, "data %s /",vars[varnum].lname);
348    stmnt_len = strlen(stmnt);
349    switch (vars[varnum].type) {
350    case NC_BYTE:
351 charvalp = (char *) rec_start;
352 for (ival = 0; ival < var_len-1; ival++) {
353     val_string = fstring(NC_BYTE,(void *)charvalp++,0);
354     sprintf(s2, "%s, ", val_string);
355     fstrcat(stmnts2, &stmnt_len);
356     free(val_string);
357 }
358 val_string = fstring(NC_BYTE,(void *)charvalp++,0);
359 fstrcat(stmntval_string, &stmnt_len);
360 free(val_string);
361 break;
362    case NC_SHORT:
363 shortvalp = (short *) rec_start;
364 for (ival = 0; ival < var_len-1; ival++) {
365     sprintf(s2, "%d, ", *shortvalp++);
366     fstrcat(stmnts2, &stmnt_len);
367 }
368 sprintf(s2, "%d", *shortvalp);
369 fstrcat(stmnts2, &stmnt_len);
370 break;
371    case NC_INT:
372 intvalp = (int *) rec_start;
373 for (ival = 0; ival < var_len-1; ival++) {
374     sprintf(s2, "%ld, ", (long)*intvalp++);
375     fstrcat(stmnts2, &stmnt_len);
376 }
377 sprintf(s2, "%ld", (long)*intvalp);
378 fstrcat(stmnts2, &stmnt_len);
379 break;
380    case NC_FLOAT:
381 floatvalp = (float *) rec_start;
382 for (ival = 0; ival < var_len-1; ival++) {
383     sprintf(s2, "%.8g, ", *floatvalp++);
384     fstrcat(stmnts2, &stmnt_len);
385 }
386 sprintf(s2, "%.8g", *floatvalp);
387 fstrcat(stmnts2, &stmnt_len);
388 break;
389    case NC_DOUBLE:
390 doublevalp = (double *) rec_start;
391 for (ival = 0; ival < var_len-1; ival++) {
392     sprintf(s2, "%#.16g", *doublevalp++);
393     tztrim(s2);
394     expe2d(s2); /* change 'e' to 'd' in exponent */
395     fstrcat(s2, ", ", &stmnt_len);
396     fstrcat(stmnts2, &stmnt_len);
397 }
398 sprintf(s2, "%#.16g", *doublevalp++);
399 tztrim(s2);
400 expe2d(s2);
401 fstrcat(stmnts2, &stmnt_len);
402 break;
403    default:
404 derror("fstrstr: bad type");
405 break;
406    }
407    fstrcat(stmnt, "/", &stmnt_len);
408
409    /* For record variables, store data statement for later use;
410      otherwise, just print it. */
411    if (vars[varnum].ndims > 0 && vars[varnum].dims[0] == rec_dim) {
412 char *dup_stmnt = emalloc(strlen(stmnt)+1);
413 strcpy(dup_stmntstmnt); /* ULTRIX missing strdup */
414 vars[varnum].data_stmnt = dup_stmnt;
415    } else {
416 fline(stmnt);
417    }
418}
419
420
421/* make Fortran to put record */
422static void
423gen_load_fortran(
424    void *rec_start
425    )
426{
427    char stmnt[FORT_MAX_STMNT];
428    struct vars *v = &vars[varnum];
429
430    if (!v->has_data)
431 return;
432
433    if (v->ndims == 0 || v->dims[0] != rec_dim) {
434 sprintf(stmnt, "* store %s", v->name);
435 fline(stmnt);
436    }
437
438    /* generate code to initialize variable with values found in CDL input */
439    if (v->type != NC_CHAR) {
440 f_var_init(varnumrec_start);
441    } else {
442 v->data_stmnt = fstrstr(rec_startvalnum);
443    }
444
445    if (v->ndims >0 && v->dims[0] == rec_dim) {
446 return;
447    }
448    if (v->type != NC_CHAR) {
449 sprintf(stmnt, "iret = nf_put_var_%s(ncid, %s_id, %s)",
450 nfftype(v->type), v->lnamev->lname);
451    } else {
452 char *char_expr = fstrstr(rec_startvalnum);
453 if(strlen("iret = nf_put_var_(ncid, _id, )") +
454    strlen(nfftype(v->type)) +
455    strlen(v->lname) +
456    strlen(char_expr) > FORT_MAX_STMNT) {
457     derror("FORTRAN statement to assign values to %s too long!",
458    v->lname);
459     exit(9);
460 }
461 sprintf(stmnt, "iret = nf_put_var_%s(ncid, %s_id, %s)",
462 nfftype(v->type), v->lnamechar_expr);
463 free(char_expr);
464    }
465
466    fline(stmnt);
467    fline("call check_err(iret)");
468}
469
470
471/* invoke netcdf calls (or generate C or Fortran code) to load netcdf variable
472 * from in-memory data.  Assumes following global variables set from yacc
473 * parser:
474 * int varnum        - number of variable to be loaded.
475 * struct vars[varnum] - structure containing info on variable, specifically
476 *                     name, type, ndims, dims, fill_value, has_data
477 * int rec_dim       - id of record dimension, or -1 if none
478 * struct dims[]     - structure containing name and size of dimensions.
479 */
480int
481put_variable(
482    void *rec_start /* points to data to be loaded  */
483    )
484{
485    if (netcdf_flag)
486      load_netcdf(rec_start); /* put variable values */
487    if (c_flag) /* create C code to put values */
488      gen_load_c(rec_start);
489    if (fortran_flag) /* create Fortran code to put values */
490      gen_load_fortran(rec_start);
491
492    return 0;
493}
494
495
496/* write out variable's data from in-memory structure */
497void
498load_netcdf(
499    void *rec_start
500    )
501{
502    int idim;
503    int stat = NC_NOERR;
504    size_t start[NC_MAX_VAR_DIMS];
505    size_t count[NC_MAX_VAR_DIMS];
506    char *charvalp;
507    short *shortvalp;
508    int *intvalp;
509    float *floatvalp;
510    double *doublevalp;
511
512    /* load values into variable */
513
514    switch (vars[varnum].type) {
515      case NC_CHAR:
516      case NC_BYTE:
517 charvalp = (char *) rec_start;
518 break;
519      case NC_SHORT:
520 shortvalp = (short *) rec_start;
521 break;
522      case NC_INT:
523 intvalp = (int *) rec_start;
524 break;
525      case NC_FLOAT:
526 floatvalp = (float *) rec_start;
527 break;
528      case NC_DOUBLE:
529 doublevalp = (double *) rec_start;
530 break;
531      default: break;
532    }
533    if (vars[varnum].ndims > 0) {
534 /* initialize start to upper left corner (0,0,0,...) */
535 start[0] = 0;
536 if (vars[varnum].dims[0] == rec_dim) {
537     count[0] = vars[varnum].nrecs;
538 }
539 else {
540     count[0] = dims[vars[varnum].dims[0]].size;
541 }
542    }
543
544    for (idim = 1; idim < vars[varnum].ndimsidim++) {
545 start[idim] = 0;
546 count[idim] = dims[vars[varnum].dims[idim]].size;
547    }
548
549    switch (vars[varnum].type) {
550      case NC_BYTE:
551 stat = nc_put_vara_schar(ncidvarnumstartcount,
552  (signed char *)charvalp);
553 break;
554      case NC_CHAR:
555 stat = nc_put_vara_text(ncidvarnumstartcountcharvalp);
556 break;
557      case NC_SHORT:
558 stat = nc_put_vara_short(ncidvarnumstartcountshortvalp);
559 break;
560      case NC_INT:
561 stat = nc_put_vara_int(ncidvarnumstartcountintvalp);
562 break;
563      case NC_FLOAT:
564 stat = nc_put_vara_float(ncidvarnumstartcountfloatvalp);
565 break;
566      case NC_DOUBLE:
567 stat = nc_put_vara_double(ncidvarnumstartcountdoublevalp);
568 break;
569      default: break;
570    }
571    check_err(stat);
572}


HyperKWIC - Version 7.20DA executed at 11:37 on 27 Oct 2017 | Polyhedron Solutions - INTERNAL USE | COMMERCIAL (Any O/S) SN 4AKIed