Integer FATR eaf_stat_(_fcd p, Integer *avail_kb, _fcd fst)
{
char *path = _fcdtocp(p);
int pathlen = _fcdlen(p);
char *fstype = _fcdtocp(fst);
int fslen = _fcdlen(fst);
#else
Integer FATR eaf_stat_(const char *path, Integer *avail_kb, char *fstype,
int pathlen, int fslen)
{
#endif
char pbuf[1024];
char fbuf[32];
int code, kb;
if (!fortchar_to_string(path, pathlen, pbuf, sizeof(pbuf)))
return (Integer) EAF_ERR_TOO_LONG;
code = eaf_stat(pbuf, &kb, fbuf, sizeof(fbuf));
if (!code) {
if (!string_to_fortchar(fstype, fslen, fbuf))
return (Integer) EAF_ERR_TOO_SHORT;
*avail_kb = (double) kb;
}
return code;
}
void FATR util_date_(_fcd date)
{
int nlen = _fcdlen(date);
#else
void util_date_(char *date, int nlen)
{
#endif
time_t t = time((time_t *) 0);
char *tmp = ctime(&t);
(void) string_to_fortchar(date, nlen, tmp);
}
void FATR eaf_errmsg_(Integer *code, _fcd m)
{
char *msg = _fcdtocp(m);
int msglen = _fcdlen(m);
#else
void FATR eaf_errmsg_(Integer *code, char *msg, int msglen)
{
#endif
char buf[80];
eaf_errmsg((int) *code, buf);
(void) string_to_fortchar(msg, msglen, buf);
}
Logical FATR srtdb_next_(const Integer *handle, char *name, int nlen)
#endif
{
#if (defined(_CRAY) || defined(USE_FCD)) && !defined(__crayx1)
// dummy arg, value reassigned by string_to_fortchar in this case
int nlen = _fcdlen(name);
#endif
char nbuf[256];
if (srtdb_next((int) *handle, (int) sizeof(nbuf), nbuf) &&
string_to_fortchar(name, nlen, nbuf))
return FORTRAN_TRUE;
else
return FORTRAN_FALSE;
}
void FATR checksum_final_(_fcd f)
{
int flen = _fcdlen(f);
#else
void FATR checksum_final_(char *f, int flen)
{
#endif
char tmp[33];
checksum_final(tmp);
if (!string_to_fortchar(f, flen, tmp)) {
fprintf(stderr,"checksum_final_: sum needs 32 chars have %d\n", flen);
exit(1);
}
}
Logical FATR srtdb_get_info_(const Integer *handle, _fcd name,
Integer *ma_type, Integer *nelem, _fcd date)
{
int nlen = _fcdlen(name);
int dlen = _fcdlen(date);
#else
Logical FATR srtdb_get_info_(const Integer *handle, const char *name,
Integer *ma_type, Integer *nelem, char *date,
const int nlen, const int dlen)
{
#endif
int hbuf = (int) *handle;
char dbuf[26], nbuf[256];
int nelbuf, typebuf;
if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
(void) fprintf(stderr, "srtdb_get_info: nbuf is too small, need=%d\n",
nlen);
return FORTRAN_FALSE;
}
if (dlen < 24) {
(void) fprintf(stderr, "srtdb_get_info: date must be > character*24\n");
return FORTRAN_FALSE;
}
if (srtdb_get_info(hbuf, nbuf, &typebuf, &nelbuf, dbuf)) {
*ma_type = (Integer) typebuf;
*nelem = (Integer) nelbuf;
if (typebuf == MT_CHAR) /* Fortran is ignorant of trailing null char */
*nelem = *nelem - 1;
if (!string_to_fortchar(date, dlen, dbuf)) {
(void) fprintf(stderr, "srtdb_get_info: nbuf is too small, need=%d\n",
nlen);
return FORTRAN_FALSE;
}
return FORTRAN_TRUE;
}
else {
return FORTRAN_FALSE;
}
}
Logical FATR srtdb_cget_(const Integer *handle, _fcd name,
const Integer *nelem,
_fcd farray)
{
int nlen = _fcdlen(name);
int alen = _fcdlen(farray);
char *array = _fcdtocp(farray);
#else
Logical FATR srtdb_cget_(const Integer *handle, const char *name,
const Integer *nelem,
char *array, const int nlen, const int alen)
{
#endif
/*
Read an array of Fortran character variables from the data base.
Put stored the array as follows:
. Each array element is striped of trailing blanks, terminated with CR,
. and appended to the list. The entire array must fit into abuf.
*/
int hbuf = (int) *handle;
char nbuf[256];
char abuf[20480];
/* char abuf[10240];*/
int nelbuf;
int typebuf;
int i;
char *next;
if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
(void) fprintf(stderr, "srtdb_cget: nbuf is too small, need=%d\n",
nlen);
return FORTRAN_FALSE;
}
nelbuf = sizeof(abuf);
typebuf= (int) MT_CHAR;
#ifdef DEBUG
printf("cget: rtdb=%d, mat=%d, nel=%d, name=%s\n", hbuf, typebuf, nelbuf, nbuf);
fflush(stdout);
#endif
if (!srtdb_get(hbuf, nbuf, typebuf, nelbuf, abuf))
return FORTRAN_FALSE; /* Not there */
for (i=0, next=strtok(abuf, "\n");
next;
i++, array+=alen, next=strtok((char *) 0, "\n")) {
#if defined(CRAY) && !defined(__crayx1)
_fcd element = _cptofcd(array, alen);
#elif defined(WIN32)
_fcd element;
element.string = array;
element.len = alen;
#elif defined(USE_FCD)
#error Do something about _fcd
#else
char *element = array;
#endif
if (i == *nelem) {
(void) fprintf(stderr, "srtdb_cget: array has too few elements\n");
(void) fprintf(stderr, "srtdb_cget: name was <<%s>>\n",name);
return FORTRAN_FALSE;
}
if (!string_to_fortchar(element, alen, next)) {
(void) fprintf(stderr, "srtdb_cget: array element is too small\n");
(void) fprintf(stderr, "srtdb_cget: name was <<%s>>\n",name);
return FORTRAN_FALSE;
}
}
return FORTRAN_TRUE;
}
