15
#include "ip_global.h"
17
#include "ip_error.gbl"
19
/* The way the AIX xlc compiler handles vararg decs isn't compatible with
20
* the way the tmpl file is formed, so ip_data.global cannot be used.
21
* Everything global should be defined before it is used here. */
22
/* NOTE: ip_data.global will work fine (and be correct) for other source
23
* files. It's just this one that is a problem because xlc thinks my
24
* declarations below are different than the ones in the global file
25
* (and they are-sort of). */
27
#include "ip_data.gbl"
30
#include "ip_data.lcl"
34
int ip_count(char *keyword, int *count, int n, ...)
42
return ip_count_v(keyword,count,n,NULL);
45
v = (int *) malloc(sizeof(int)*n);
46
if (!v) return IPE_MALLOC;
49
v[i] = va_arg(args,int);
52
r = ip_count_v(keyword,count,n,v);
58
int ip_count_v(char *keyword, int *count, int n, int *v)
63
if ((errcod = ip_value_v(keyword,&val,n,v))) return errcod;
65
if (val->type != IP_ARRAY) return IPE_NOT_AN_ARRAY;
67
*count = val->v.array->n;
71
int ip_boolean(char *keyword, int *boolean, int n, ...)
79
return ip_boolean_v(keyword,boolean,n,NULL);
82
v = (int *) malloc(sizeof(int)*n);
83
if (!v) return IPE_MALLOC;
86
v[i] = va_arg(args,int);
89
r = ip_boolean_v(keyword,boolean,n,v);
95
int ip_boolean_v(char *keyword, int *boolean, int n, int *v)
101
if ((errcod = ip_value_v(keyword,&val,n,v))) return errcod;
103
if (val->type != IP_SCALAR) return IPE_NOT_A_SCALAR;
105
strncpy(copy,val->v.scalar,10);
108
/* Convert the string to uppercase. */
109
for (s=copy; *s!='\0'; s++) {
110
if (*s>='a' && *s <='z') *s = *s + 'A' - 'a';
113
if (!strcmp(copy,"YES")) *boolean = 1;
114
else if (!strcmp(copy,"NO")) *boolean = 0;
115
else if (!strcmp(copy,"1")) *boolean = 1;
116
else if (!strcmp(copy,"0")) *boolean = 0;
117
else if (!strcmp(copy,"TRUE")) *boolean = 1;
118
else if (!strcmp(copy,"FALSE")) *boolean = 0;
119
else return IPE_TYPE;
124
/* n should always be zero in this version of libip. */
125
int ip_exist(char *keyword, int n, ...)
133
return ip_exist_v(keyword,n,NULL);
136
v = (int *) malloc(sizeof(int)*n);
138
ip_warn("ip_exist: problem mallocing %d integers",n);
142
for (i=0; i<n; i++) {
143
v[i] = va_arg(args,int);
146
r = ip_exist_v(keyword,n,v);
152
/* n should always be zero in this version of libip. */
153
int ip_exist_v(char *keyword, int n, int *v)
155
if (ip_cwk_descend_tree(keyword)) return 1;
160
int ip_data(char *keyword, char *conv, void *value, int n, ...)
168
return ip_data_v(keyword,conv,value,n,NULL);
171
v = (int *) malloc(sizeof(int)*n);
172
if (!v) return IPE_MALLOC;
174
for (i=0; i<n; i++) {
175
v[i] = va_arg(args,int);
178
r = ip_data_v(keyword,conv,value,n,v);
184
int ip_data_v(char *keyword, char *conv, void *value, int n, int *v)
189
if ((errcod = ip_value_v(keyword,&val,n,v))) return errcod;
191
if (val->type != IP_SCALAR) return IPE_NOT_A_SCALAR;
193
if (sscanf(val->v.scalar,conv,value) != 1) return IPE_TYPE;
198
int ip_string(char *keyword, char **value, int n, ...)
206
return ip_string_v(keyword,value,n,NULL);
209
v = (int *) malloc(sizeof(int)*n);
210
if (!v) return IPE_MALLOC;
212
for (i=0; i<n; i++) {
213
v[i] = va_arg(args,int);
216
r = ip_string_v(keyword,value,n,v);
222
int ip_string_v(char *keyword, char **value, int n, int *v)
227
if ((errcod = ip_value_v(keyword,&val,n,v))) return errcod;
229
if (val->type != IP_SCALAR) return IPE_NOT_A_SCALAR;
231
*value = (char *) malloc(sizeof(char)*(strlen(val->v.scalar)+1));
232
if (! *value) return IPE_MALLOC;
233
strcpy(*value,val->v.scalar);
237
int ip_value(char *keyword, ip_value_t **value, int n, ...)
245
return ip_value_v(keyword,value,n,NULL);
248
v = (int *) malloc(sizeof(int)*n);
249
if (!v) return IPE_MALLOC;
251
for (i=0; i<n; i++) {
252
v[i] = va_arg(args,int);
255
r = ip_value_v(keyword,value,n,v);
261
int ip_value_v(char *keyword, ip_value_t **value, int n, int *v)
266
/* Use the cwk list to obtain the value associated with the keyword. */
267
val = ip_key_value(keyword);
268
if (!val) return IPE_KEY_NOT_FOUND;
270
/* Descend thru val to find the subarray that were are interested in. */
271
for (i=0; i<n; i++) {
272
if (val->type != IP_ARRAY) return IPE_NOT_AN_ARRAY;
273
if (v[i] < 0) return IPE_OUT_OF_BOUNDS;
274
if (v[i] >= val->v.array->n) return IPE_OUT_OF_BOUNDS;
275
val = val->v.array->values[v[i]];
286
** Function reads in an integer array using the PSI input parser.
287
** It checks for errors at all stages and makes sure that the array
288
** has the proper length.
291
** Center for Computational Quantum Chemistry
295
** keyword = string containing the keyword for the input parser
296
** arr = array to hold results
297
** len = length of array
299
** Returns: IP Error code
301
** Note: keyword should ordinarily be an uppercase string.
304
int ip_int_array(char *keyword, int *arr, int len)
308
errcod = ip_count(keyword,&cnt,0);
309
if (errcod != IPE_OK) return(errcod);
311
fprintf(ip_out," (ip_int_array): Trouble parsing %s array.\n", keyword);
312
fprintf(ip_out," Length is %d should be %d\n",cnt,len);
313
return(IPE_OUT_OF_BOUNDS);
315
for (i=0; i<len; i++) {
316
errcod = ip_data(keyword,"%d",arr+i,1,i);
317
if (errcod != IPE_OK) {
318
fprintf(ip_out," (ip_int_array): Trouble parsing %s array element %d\n",
320
ip_warn(ip_error_message(errcod));
332
** Function reads in an array of doubles using the PSI input parser.
333
** It checks for errors at all stages and makes sure that the array
334
** has the proper length.
336
** Based on ip_int_array by C. David Sherrill
339
** keyword = string containing the keyword for the input parser
340
** arr = array to hold results
341
** len = length of array
343
** Returns: IP Error code
346
int ip_double_array(char *keyword, double *arr, int len)
350
errcod = ip_count(keyword,&cnt,0);
351
if (errcod != IPE_OK) return(errcod);
353
fprintf(ip_out," (ip_array): Trouble parsing %s array.\n", keyword);
354
fprintf(ip_out," Length is %d should be %d\n",cnt,len);
355
return(IPE_OUT_OF_BOUNDS);
357
for (i=0; i<len; i++) {
358
errcod = ip_data(keyword,"%lf",arr+i,1,i);
359
if (errcod != IPE_OK) {
360
fprintf(ip_out," (ip_array): Trouble parsing %s array element %d\n",
362
ip_warn(ip_error_message(errcod));