l_read(ftnint *number, char *ptr, ftnlen len, ftnint type)
#endif
{
#define Ptr ((flex *)ptr)
int i,n,ch;
doublereal *yy;
real *xx;
for(i=0;i<*number;i++)
{
if(f__lquit) return(0);
if(l_eof)
err(f__elist->ciend, EOF, "list in")
if(f__lcount == 0) {
f__ltype = 0;
for(;;) {
GETC(ch);
switch(ch) {
case EOF:
err(f__elist->ciend,(EOF),"list in")
case ' ':
case '\t':
case '\n':
continue;
case '/':
f__lquit = 1;
goto loopend;
case ',':
f__lcount = 1;
goto loopend;
default:
(void) Ungetc(ch, f__cf);
goto rddata;
}
}
}
rddata:
switch((int)type)
{
case TYINT1:
case TYSHORT:
case TYLONG:
#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
ERR(l_R(0,1));
break;
#endif
case TYREAL:
case TYDREAL:
ERR(l_R(0,0));
break;
#ifdef TYQUAD
case TYQUAD:
n = l_R(0,2);
if (n)
return n;
break;
#endif
case TYCOMPLEX:
case TYDCOMPLEX:
ERR(l_C());
break;
case TYLOGICAL1:
case TYLOGICAL2:
case TYLOGICAL:
ERR(l_L());
break;
case TYCHAR:
ERR(l_CHAR());
break;
}
while (GETC(ch) == ' ' || ch == '\t');
if (ch != ',' || f__lcount > 1)
Ungetc(ch,f__cf);
loopend:
if(f__lquit) return(0);
if(f__cf && ferror(f__cf)) {
clearerr(f__cf);
errfl(f__elist->cierr,errno,"list in");
}
if(f__ltype==0) goto bump;
switch((int)type)
{
case TYINT1:
case TYLOGICAL1:
Ptr->flchar = (char)f__lx;
break;
case TYLOGICAL2:
case TYSHORT:
Ptr->flshort = (short)f__lx;
break;
case TYLOGICAL:
case TYLONG:
Ptr->flint = (ftnint)f__lx;
break;
#ifdef Allow_TYQUAD
case TYQUAD:
if (!(Ptr->fllongint = f__llx))
Ptr->fllongint = f__lx;
break;
#endif
case TYREAL:
Ptr->flreal=f__lx;
break;
case TYDREAL:
Ptr->fldouble=f__lx;
break;
case TYCOMPLEX:
xx=(real *)ptr;
*xx++ = f__lx;
*xx = f__ly;
break;
case TYDCOMPLEX:
yy=(doublereal *)ptr;
*yy++ = f__lx;
*yy = f__ly;
break;
case TYCHAR:
b_char(f__lchar,ptr,len);
break;
}
bump:
if(f__lcount>0) f__lcount--;
ptr += len;
if (nml_read)
nml_read++;
}
static int
l_read(ftnint *number,flex *ptr,ftnlen len,ftnint type)
{ int i,n,ch;
double *yy;
float *xx;
for(i=0;i<*number;i++)
{
if(curunit->uend) err(elist->ciend, EOF, "list in")
if(l_first)
{ l_first=0;
for(GETC(ch);isblnk(ch);GETC(ch));
ungetc(ch,cf);
}
else if(lcount==0)
{ ERR(t_sep());
if(lquit) return(0);
}
switch((int)type)
{
case TYSHORT:
case TYLONG:
case TYREAL:
case TYDREAL:
ERR(l_R());
break;
case TYCOMPLEX:
case TYDCOMPLEX:
ERR(l_C());
break;
case TYLOGICAL:
ERR(l_L());
break;
case TYCHAR:
ERR(l_CHAR());
break;
}
if(lquit) return(0);
if(feof(cf)) err(elist->ciend,(EOF),"list in")
else if(ferror(cf))
{ clearerr(cf);
err(elist->cierr,errno,"list in")
}
if(ltype==0) goto bump;
switch((int)type)
{
case TYSHORT:
ptr->flshort=lx;
break;
case TYLOGICAL:
case TYLONG:
ptr->flint=lx;
break;
case TYREAL:
ptr->flreal=lx;
break;
case TYDREAL:
ptr->fldouble=lx;
break;
case TYCOMPLEX:
xx=(float *)ptr;
*xx++ = lx;
*xx = ly;
break;
case TYDCOMPLEX:
yy=(double *)ptr;
*yy++ = lx;
*yy = ly;
break;
case TYCHAR:
b_char(lchar,(char *)ptr,len);
break;
}
bump:
if(lcount>0) lcount--;
ptr = (flex *)((char *)ptr + len);
}
return(0);
}
