1 /*$Id$*/
2 #include <stdio.h>
3 #include <string.h>
4 #include "srtdb.h"
5 #include "macdecls.h"
6 #ifdef CRAY
7 #include <fortran.h>
8 #endif
9
10 #define FORTRAN_TRUE ((Logical) 1)
11 #define FORTRAN_FALSE ((Logical) 0)
12
13
14 #if (defined(CRAY) || defined(USE_FCD)) && !defined(__crayx1)
srtdb_open_(_fcd filename,_fcd mode,Integer * handle)15 Logical FATR srtdb_open_(_fcd filename, _fcd mode, Integer *handle)
16 {
17 int flen = _fcdlen(filename);
18 int mlen = _fcdlen(mode);
19 #else
20 Logical FATR srtdb_open_(const char *filename, const char *mode, Integer *handle,
21 const Integer flen, const Integer mlen)
22 {
23 #endif
24 char fbuf[256], mbuf[256];
25 int hbuf;
26
27 if (!fortchar_to_string(filename, flen, fbuf, sizeof(fbuf))) {
28 (void) fprintf(stderr, "srtdb_open: fbuf is too small, need=%d\n",
29 (int) flen);
30 return FORTRAN_FALSE;
31 }
32
33 if (!fortchar_to_string(mode, mlen, mbuf, sizeof(mbuf))) {
34 (void) fprintf(stderr, "srtdb_open: mbuf is too small, need=%d\n",
35 (int) mlen);
36 return FORTRAN_FALSE;
37 }
38
39 if (srtdb_open(fbuf, mbuf, &hbuf)) {
40 *handle = (Integer) hbuf;
41 return FORTRAN_TRUE;
42 }
43 else {
44 return FORTRAN_FALSE;
45 }
46 }
47
48
49 #if (defined(CRAY) || defined(USE_FCD)) && !defined(__crayx1)
50 Logical FATR srtdb_close_(const Integer *handle, _fcd mode)
51 {
52 int mlen = _fcdlen(mode);
53 #else
54 Logical FATR srtdb_close_(const Integer *handle, const char *mode, const int mlen)
55 {
56 #endif
57 char mbuf[256];
58 int hbuf = (int) *handle;
59
60 if (!fortchar_to_string(mode, mlen, mbuf, sizeof(mbuf))) {
61 (void) fprintf(stderr, "srtdb_close: mbuf is too small, need=%d\n", mlen);
62 return FORTRAN_FALSE;
63 }
64 if (srtdb_close(hbuf, mbuf))
65 return FORTRAN_TRUE;
66 else
67 return FORTRAN_FALSE;
68 }
69 #if (defined(CRAY) || defined(USE_FCD)) && !defined(__crayx1)
70 Logical FATR srtdb_get_info_(const Integer *handle, _fcd name,
71 Integer *ma_type, Integer *nelem, _fcd date)
72 {
73 int nlen = _fcdlen(name);
74 int dlen = _fcdlen(date);
75 #else
76 Logical FATR srtdb_get_info_(const Integer *handle, const char *name,
77 Integer *ma_type, Integer *nelem, char *date,
78 const int nlen, const int dlen)
79 {
80 #endif
81
82 int hbuf = (int) *handle;
83 char dbuf[26], nbuf[256];
84 int nelbuf, typebuf;
85
86 if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
87 (void) fprintf(stderr, "srtdb_get_info: nbuf is too small, need=%d\n",
88 nlen);
89 return FORTRAN_FALSE;
90 }
91
92 if (dlen < 24) {
93 (void) fprintf(stderr, "srtdb_get_info: date must be > character*24\n");
94 return FORTRAN_FALSE;
95 }
96
97 if (srtdb_get_info(hbuf, nbuf, &typebuf, &nelbuf, dbuf)) {
98 *ma_type = (Integer) typebuf;
99 *nelem = (Integer) nelbuf;
100
101 if (typebuf == MT_CHAR) /* Fortran is ignorant of trailing null char */
102 *nelem = *nelem - 1;
103
104 if (!string_to_fortchar(date, dlen, dbuf)) {
105 (void) fprintf(stderr, "srtdb_get_info: nbuf is too small, need=%d\n",
106 nlen);
107 return FORTRAN_FALSE;
108 }
109
110 return FORTRAN_TRUE;
111 }
112 else {
113 return FORTRAN_FALSE;
114 }
115 }
116 #if (defined(CRAY) || defined(USE_FCD)) && !defined(__crayx1)
117 Logical FATR srtdb_put_(const Integer *handle, _fcd name, const Integer *ma_type,
118 const Integer *nelem, const void *array)
119 {
120 int nlen = _fcdlen(name);
121 #else
122 Logical FATR srtdb_put_(const Integer *handle, const char *name, const Integer *ma_type,
123 const Integer *nelem, const void *array, const int nlen)
124 {
125 #endif
126 int hbuf = (int) *handle;
127 char nbuf[256];
128 int nelbuf;
129 int typebuf;
130
131 if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
132 (void) fprintf(stderr, "srtdb_put: nbuf is too small, need=%d\n",
133 nlen);
134 return FORTRAN_FALSE;
135 }
136
137 nelbuf = (int) *nelem;
138 typebuf= (int) *ma_type;
139
140 #ifdef DEBUG
141 printf("put: rtdb=%d, mat=%d, nel=%d, name=%s\n", hbuf, typebuf, nelbuf, nbuf);
142 fflush(stdout);
143 #endif
144
145 if (srtdb_put(hbuf, nbuf, typebuf, nelbuf, array))
146 return FORTRAN_TRUE;
147 else
148 return FORTRAN_FALSE;
149 }
150 #if (defined(CRAY) || defined(USE_FCD)) && !defined(__crayx1)
151 Logical FATR srtdb_get_(const Integer *handle, _fcd name,
152 const Integer *ma_type, const Integer *nelem,
153 void *array)
154 {
155 int nlen = _fcdlen(name);
156 #else
157 Logical FATR srtdb_get_(const Integer *handle, const char *name,
158 const Integer *ma_type, const Integer *nelem,
159 void *array, const int nlen)
160 {
161 #endif
162 int hbuf = (int) *handle;
163 char nbuf[256];
164 int nelbuf;
165 int typebuf;
166
167 if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
168 (void) fprintf(stderr, "srtdb_get: nbuf is too small, need=%d\n",
169 nlen);
170 return FORTRAN_FALSE;
171 }
172
173 nelbuf = (int) *nelem;
174 typebuf= (int) *ma_type;
175
176 #ifdef DEBUG
177 printf("get: rtdb=%d, mat=%d, nel=%d, name=%s\n", hbuf, typebuf, nelbuf, nbuf);
178 fflush(stdout);
179 #endif
180
181 if (srtdb_get(hbuf, nbuf, typebuf, nelbuf, array)) {
182 return FORTRAN_TRUE;
183 }
184 else
185 return FORTRAN_FALSE;
186 }
187
188
189 Logical FATR srtdb_print_(const Integer *handle, const Logical *print_values)
190 {
191 int hbuf = (int) *handle;
192 int pbuf = (int) *print_values;
193
194 if (srtdb_print(hbuf, pbuf))
195 return FORTRAN_TRUE;
196 else
197 return FORTRAN_FALSE;
198 }
199
200 #if (defined(CRAY) || defined(USE_FCD)) && !defined(__crayx1)
201 Logical FATR srtdb_cput_(const Integer *handle, _fcd name,
202 const Integer *nelem,
203 _fcd farray)
204 {
205 int nlen = _fcdlen(name);
206 int alen = _fcdlen(farray);
207 char *array = _fcdtocp(farray);
208 #else
209 Logical FATR srtdb_cput_(const Integer *handle, const char *name,
210 const Integer *nelem,
211 const char *array, const int nlen, const int alen)
212 {
213 #endif
214 /*
215 Insert an array of Fortran character variables into the data base.
216 Each array element is striped of trailing blanks, terminated with CR,
217 and appended to the list. The entire array must fit into abuf.
218 */
219
220 int hbuf = (int) *handle;
221 char nbuf[256];
222 char abuf[20480]=" ";
223 int nelbuf;
224 int typebuf;
225 int i, left;
226 char *next;
227 for (i=0, left=sizeof(abuf), next=abuf;
228 i<*nelem;
229 i++, array+=alen) {
230 #if defined(CRAY) && !defined(__crayx1)
231 _fcd element = _cptofcd(array, alen);
232 #elif defined(WIN32)
233 _fcd element;
234 element.string = array;
235 element.len = alen;
236 #elif defined(USE_FCD)
237 #error Do something about _fcd
238 #else
239 const char *element = array;
240 #endif
241
242 if (!fortchar_to_string(element, alen, next, left)) {
243 (void) fprintf(stderr, "srtdb_cput: abuf is too small, need=%d\n",
244 (int) (alen + sizeof(abuf) - left));
245 return FORTRAN_FALSE;
246 }
247 left -= strlen(next) + 1;
248 next += strlen(next) + 1;
249 if (i != (*nelem - 1))
250 *(next-1) = '\n';
251 }
252
253 if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
254 (void) fprintf(stderr, "srtdb_cput: nbuf is too small, need=%d\n",
255 nlen);
256 return FORTRAN_FALSE;
257 }
258
259 nelbuf = strlen(abuf) + 1;
260 typebuf= (int) MT_CHAR;
261
262 #ifdef DEBUG
263 printf("cput: rtdb=%d, mat=%d, nel=%d, name=%s\n", hbuf, typebuf, nelbuf, nbuf);
264 fflush(stdout);
265 #endif
266
267 if (srtdb_put(hbuf, nbuf, typebuf, nelbuf, abuf))
268 return FORTRAN_TRUE;
269 else
270 return FORTRAN_FALSE;
271 }
272
273
274 #if (defined(CRAY) || defined(USE_FCD)) && !defined(__crayx1)
275 Logical FATR srtdb_cget_(const Integer *handle, _fcd name,
276 const Integer *nelem,
277 _fcd farray)
278 {
279 int nlen = _fcdlen(name);
280 int alen = _fcdlen(farray);
281 char *array = _fcdtocp(farray);
282 #else
283 Logical FATR srtdb_cget_(const Integer *handle, const char *name,
284 const Integer *nelem,
285 char *array, const int nlen, const int alen)
286 {
287 #endif
288 /*
289 Read an array of Fortran character variables from the data base.
290
291 Put stored the array as follows:
292 . Each array element is striped of trailing blanks, terminated with CR,
293 . and appended to the list. The entire array must fit into abuf.
294 */
295
296 int hbuf = (int) *handle;
297 char nbuf[256];
298 char abuf[20480];
299 /* char abuf[10240];*/
300 int nelbuf;
301 int typebuf;
302 int i;
303 char *next;
304
305 if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
306 (void) fprintf(stderr, "srtdb_cget: nbuf is too small, need=%d\n",
307 nlen);
308 return FORTRAN_FALSE;
309 }
310
311 nelbuf = sizeof(abuf);
312 typebuf= (int) MT_CHAR;
313
314 #ifdef DEBUG
315 printf("cget: rtdb=%d, mat=%d, nel=%d, name=%s\n", hbuf, typebuf, nelbuf, nbuf);
316 fflush(stdout);
317 #endif
318
319 if (!srtdb_get(hbuf, nbuf, typebuf, nelbuf, abuf))
320 return FORTRAN_FALSE; /* Not there */
321
322 for (i=0, next=strtok(abuf, "\n");
323 next;
324 i++, array+=alen, next=strtok((char *) 0, "\n")) {
325 #if defined(CRAY) && !defined(__crayx1)
326 _fcd element = _cptofcd(array, alen);
327 #elif defined(WIN32)
328 _fcd element;
329 element.string = array;
330 element.len = alen;
331 #elif defined(USE_FCD)
332 #error Do something about _fcd
333 #else
334 char *element = array;
335 #endif
336
337 if (i == *nelem) {
338 (void) fprintf(stderr, "srtdb_cget: array has too few elements\n");
339 (void) fprintf(stderr, "srtdb_cget: name was <<%s>>\n",name);
340 return FORTRAN_FALSE;
341 }
342
343 if (!string_to_fortchar(element, alen, next)) {
344 (void) fprintf(stderr, "srtdb_cget: array element is too small\n");
345 (void) fprintf(stderr, "srtdb_cget: name was <<%s>>\n",name);
346 return FORTRAN_FALSE;
347 }
348 }
349 return FORTRAN_TRUE;
350 }
351
352
353 #if (defined(_CRAY) || defined(USE_FCD)) && !defined(__crayx1)
354 Logical FATR srtdb_first_(const Integer *handle, _fcd name)
355 #else
356 Logical FATR srtdb_first_(const Integer *handle, char *name, int nlen)
357 #endif
358 {
359 #if (defined(_CRAY) || defined(USE_FCD)) && !defined(__crayx1)
360 // dummy arg, value reassigned by string_to_fortchar in this case
361 int nlen = _fcdlen(name);
362 #endif
363 char nbuf[256];
364
365 if (srtdb_first((int) *handle, (int) sizeof(nbuf), nbuf) &&
366 string_to_fortchar(name, nlen, nbuf))
367 return FORTRAN_TRUE;
368 else
369 return FORTRAN_FALSE;
370 }
371
372 #if (defined(_CRAY) || defined(USE_FCD)) && !defined(__crayx1)
373 Logical FATR srtdb_next_(const Integer *handle, _fcd name)
374 #else
375 Logical FATR srtdb_next_(const Integer *handle, char *name, int nlen)
376 #endif
377 {
378 #if (defined(_CRAY) || defined(USE_FCD)) && !defined(__crayx1)
379 // dummy arg, value reassigned by string_to_fortchar in this case
380 int nlen = _fcdlen(name);
381 #endif
382 char nbuf[256];
383
384 if (srtdb_next((int) *handle, (int) sizeof(nbuf), nbuf) &&
385 string_to_fortchar(name, nlen, nbuf))
386 return FORTRAN_TRUE;
387 else
388 return FORTRAN_FALSE;
389 }
390 #if (defined(CRAY) || defined(USE_FCD)) && !defined(__crayx1)
391 Logical FATR srtdb_delete_(const Integer *handle, _fcd name)
392 {
393 int nlen = _fcdlen(name);
394 #else
395 Logical FATR srtdb_delete_(const Integer *handle, const char *name, const int nlen)
396 {
397 #endif
398 int hbuf = (int) *handle;
399 char nbuf[256];
400
401 if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
402 (void) fprintf(stderr, "srtdb_delete: nbuf is too small, need=%d\n",
403 nlen);
404 return FORTRAN_FALSE;
405 }
406
407 if (srtdb_delete(hbuf, nbuf))
408 return FORTRAN_TRUE;
409 else
410 return FORTRAN_FALSE;
411 }
412
413 extern void srtdb_print_usage(void);
414
415 void FATR srtdb_print_usage_()
416 {
417 srtdb_print_usage();
418 }
419