1/*********************************************************************
2 *   Copyright 2009, UCAR/Unidata
3 *   See netcdf/COPYRIGHT file for copying and redistribution conditions.
4 *********************************************************************/
5
6#include "includes.h"
7#include "nc_iter.h"
8
9#ifdef ENABLE_F77
10
11#include <math.h>
12
13int f77_uid = 0;
14
15static int
16f77_charconstant(GeneratorgeneratorSymbolsymBytebuffercodebuf, ...)
17{
18    /* Escapes and quoting will be handled in genc_write */
19    /* Just transfer charbuf to codebuf */
20    Bytebuffercharbuf;
21    va_list ap;
22    vastart(ap,codebuf);
23    charbuf = va_arg(apBytebuffer*);
24    va_end(ap);
25    bbNull(charbuf);
26    bbCatbuf(codebuf,charbuf);
27    return 1;
28}
29
30static int
31f77_constant(GeneratorgeneratorSymbolsymNCConstantciBytebuffercodebuf,...)
32{
33    char tmp[64];
34    char* special = NULL;
35    switch (ci->nctype) {
36
37    case NC_CHAR:
38 if(ci->value.charv == '\'')
39     sprintf(tmp,"'\\''");
40 else
41     sprintf(tmp,"'%c'",ci->value.charv);
42 break;
43    case NC_BYTE:
44 sprintf(tmp,"%hhd",ci->value.int8v);
45 break;
46    case NC_SHORT:
47 sprintf(tmp,"%hd",ci->value.int16v);
48 break;
49    case NC_INT:
50 sprintf(tmp,"%d",ci->value.int32v);
51 break;
52    case NC_FLOAT:
53 sprintf(tmp,"%.8g",ci->value.floatv);
54 break;
55    case NC_DOUBLE: {
56 char* p = tmp;
57 /* FORTRAN requires e|E->D */
58 sprintf(tmp,"%.16g",ci->value.doublev);
59 while(*p) {if(*p == 'e' || *p == 'E') {*p = 'D';}; p++;}
60 } break;
61    case NC_STRING:
62 {
63     Bytebufferbuf = bbNew();
64     bbAppendn(buf,ci->value.stringv.stringv,ci->value.stringv.len);
65     f77quotestring(buf);
66     special = bbDup(buf);
67     bbFree(buf);
68 }
69 break;
70
71    default: PANIC1("f77data: bad type code: %d",ci->nctype);
72
73    }
74    if(special != NULL)
75 bbCat(codebuf,special);
76    else
77 bbCat(codebuf,tmp);
78    return 1;
79}
80
81static int
82f77_listbegin(GeneratorgeneratorSymbolsym, void* liststateListClass lc, size_t sizeBytebuffercodebuf, int* uidp, ...)
83{
84    if(uidp) *uidp = ++f77_uid;
85    return 1;
86}
87
88static int
89f77_list(GeneratorgeneratorSymbolsym, void* liststateListClass lc, int uid, size_t countBytebuffercodebuf, ...)
90{
91    switch (lc) {
92    case LISTATTR:
93        if(count > 0) bbCat(codebuf,", ");
94 break;
95    case LISTDATA:
96        bbAppend(codebuf,' ');
97 break;
98    case LISTVLEN:
99    case LISTCOMPOUND:
100    case LISTFIELDARRAY:
101 break;
102    }
103    return 1;
104}
105
106static int
107f77_listend(GeneratorgeneratorSymbolsym, void* liststateListClass lc, int uid, size_t countBytebufferbuf, ...)
108{
109    return 1;
110}
111
112static int
113f77_vlendecl(GeneratorgeneratorSymboltsymBytebuffercodebuf, int uid, size_t count, ...)
114{
115    return 1;
116}
117
118static int
119f77_vlenstring(GeneratorgeneratorSymbolsymBytebuffervlenmem, int* uidp, size_t* countp,...)
120{
121    if(uidp) *uidp = ++f77_uid;
122    return 1;
123}
124
125/* Define the single static bin data generator  */
126static Generator f77_generator_singleton = {
127    NULL,
128    f77_charconstant,
129    f77_constant,
130    f77_listbegin,
131    f77_list,
132    f77_listend,
133    f77_vlendecl,
134    f77_vlenstring
135};
136Generatorf77_generator = &f77_generator_singleton;
137
138#endif /*ENABLE_F77*/


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