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); }