00492 {
00493         if(!f__init)
00494                 f_init();
00495         f__fmtbuf="list io";
00496         if(a->ciunit>=MXUNIT || a->ciunit<0)
00497                 err(a->cierr,101,"stler");
00498         f__scale=f__recpos=0;
00499         f__elist=a;
00500         f__curunit = &f__units[a->ciunit];
00501         if(f__curunit->ufd==NULL && fk_open(SEQ,FMT,a->ciunit))
00502                 err(a->cierr,102,"lio");
00503         f__cf=f__curunit->ufd;
00504         if(!f__curunit->ufmt) err(a->cierr,103,"lio")
00505         return(0);
00506 }

00512 {
00513 #define Ptr ((flex *)ptr)
00514         int i,n,ch;
00515         doublereal *yy;
00516         real *xx;
00517         for(i=0;i<*number;i++)
00518         {
00519                 if(f__lquit) return(0);
00520                 if(l_eof)
00521                         err(f__elist->ciend, EOF, "list in")
00522                 if(f__lcount == 0) {
00523                         f__ltype = 0;
00524                         for(;;)  {
00525                                 GETC(ch);
00526                                 switch(ch) {
00527                                 case EOF:
00528                                         err(f__elist->ciend,(EOF),"list in")
00529                                 case ' ':
00530                                 case '\t':
00531                                 case '\n':
00532                                         continue;
00533                                 case '/':
00534                                         f__lquit = 1;
00535                                         goto loopend;
00536                                 case ',':
00537                                         f__lcount = 1;
00538                                         goto loopend;
00539                                 default:
00540                                         (void) Ungetc(ch, f__cf);
00541                                         goto rddata;
00542                                 }
00543                         }
00544                 }
00545         rddata:
00546                 switch((int)type)
00547                 {
00548                 case TYINT1:
00549                 case TYSHORT:
00550                 case TYLONG:
00551                 case TYREAL:
00552                 case TYDREAL:
00553                         ERR(l_R(0));
00554                         break;
00555 #ifdef TYQUAD
00556                 case TYQUAD:
00557                         quad_read = 1;
00558                         n = l_R(0);
00559                         quad_read = 0;
00560                         if (n)
00561                                 return n;
00562                         break;
00563 #endif
00564                 case TYCOMPLEX:
00565                 case TYDCOMPLEX:
00566                         ERR(l_C());
00567                         break;
00568                 case TYLOGICAL1:
00569                 case TYLOGICAL2:
00570                 case TYLOGICAL:
00571                         ERR(l_L());
00572                         break;
00573                 case TYCHAR:
00574                         ERR(l_CHAR());
00575                         break;
00576                 }
00577         while (GETC(ch) == ' ' || ch == '\t');
00578         if (ch != ',' || f__lcount > 1)
00579                 Ungetc(ch,f__cf);
00580         loopend:
00581                 if(f__lquit) return(0);
00582                 if(f__cf && ferror(f__cf)) {
00583                         clearerr(f__cf);
00584                         errfl(f__elist->cierr,errno,"list in");
00585                         }
00586                 if(f__ltype==0) goto bump;
00587                 switch((int)type)
00588                 {
00589                 case TYINT1:
00590                 case TYLOGICAL1:
00591                         Ptr->flchar = (char)f__lx;
00592                         break;
00593                 case TYLOGICAL2:
00594                 case TYSHORT:
00595                         Ptr->flshort = (short)f__lx;
00596                         break;
00597                 case TYLOGICAL:
00598                 case TYLONG:
00599                         Ptr->flint=f__lx;
00600                         break;
00601 #ifdef Allow_TYQUAD
00602                 case TYQUAD:
00603                         if (!(Ptr->fllongint = f__llx))
00604                                 Ptr->fllongint = f__lx;
00605                         break;
00606 #endif
00607                 case TYREAL:
00608                         Ptr->flreal=f__lx;
00609                         break;
00610                 case TYDREAL:
00611                         Ptr->fldouble=f__lx;
00612                         break;
00613                 case TYCOMPLEX:
00614                         xx=(real *)ptr;
00615                         *xx++ = f__lx;
00616                         *xx = f__ly;
00617                         break;
00618                 case TYDCOMPLEX:
00619                         yy=(doublereal *)ptr;
00620                         *yy++ = f__lx;
00621                         *yy = f__ly;
00622                         break;
00623                 case TYCHAR:
00624                         b_char(f__lchar,ptr,len);
00625                         break;
00626                 }
00627         bump:
00628                 if(f__lcount>0) f__lcount--;
00629                 ptr += len;
00630                 if (nml_read)
00631                         nml_read++;
00632         }
00633         return(0);
00634 #undef Ptr
00635 }

00247 {
00248 #define Ptr ((flex *)ptr)
00249         int i;
00250         longint x;
00251         double y,z;
00252         real *xx;
00253         doublereal *yy;
00254         for(i=0;i< *number; i++)
00255         {
00256                 switch((int)type)
00257                 {
00258                 default: f__fatal(204,"unknown type in lio");
00259                 case TYINT1:
00260                         x = Ptr->flchar;
00261                         goto xint;
00262                 case TYSHORT:
00263                         x=Ptr->flshort;
00264                         goto xint;
00265 #ifdef Allow_TYQUAD
00266                 case TYQUAD:
00267                         x = Ptr->fllongint;
00268                         goto xint;
00269 #endif
00270                 case TYLONG:
00271                         x=Ptr->flint;
00272                 xint:   lwrt_I(x);
00273                         break;
00274                 case TYREAL:
00275                         y=Ptr->flreal;
00276                         goto xfloat;
00277                 case TYDREAL:
00278                         y=Ptr->fldouble;
00279                 xfloat: lwrt_F(y);
00280                         break;
00281                 case TYCOMPLEX:
00282                         xx= &Ptr->flreal;
00283                         y = *xx++;
00284                         z = *xx;
00285                         goto xcomplex;
00286                 case TYDCOMPLEX:
00287                         yy = &Ptr->fldouble;
00288                         y= *yy++;
00289                         z = *yy;
00290                 xcomplex:
00291                         lwrt_C(y,z);
00292                         break;
00293                 case TYLOGICAL1:
00294                         x = Ptr->flchar;
00295                         goto xlog;
00296                 case TYLOGICAL2:
00297                         x = Ptr->flshort;
00298                         goto xlog;
00299                 case TYLOGICAL:
00300                         x = Ptr->flint;
00301                 xlog:   lwrt_L(Ptr->flint, len);
00302                         break;
00303                 case TYCHAR:
00304                         lwrt_A(ptr,len);
00305                         break;
00306                 }
00307                 ptr += len;
00308         }
00309         return(0);
00310 }

00011 {
00012         int n;
00013 
00014         if(n=c_le(a))
00015                 return(n);
00016         f__reading=0;
00017         f__external=1;
00018         f__formatted=1;
00019         f__putn = t_putc;
00020         L_len = LINE;
00021         f__donewrec = x_wSL;
00022         if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
00023                 err(a->cierr, errno, "namelist output start");
00024         x_wsne(a);
00025         return e_wsle();
00026         }

00023 {
00024         Namelist *nl;
00025         char *s;
00026         Vardesc *v, **vd, **vde;
00027         ftnint *number, type;
00028         ftnlen *dims;
00029         ftnlen size;
00030         static ftnint one = 1;
00031         extern ftnlen f__typesize[];
00032 
00033         nl = (Namelist *)a->cifmt;
00034         PUT('&');
00035         for(s = nl->name; *s; s++)
00036                 PUT(*s);
00037         PUT(' ');
00038         f__Aquote = 1;
00039         vd = nl->vars;
00040         vde = vd + nl->nvars;
00041         while(vd < vde) {
00042                 v = *vd++;
00043                 s = v->name;
00044 #ifdef No_Extra_Namelist_Newlines
00045                 if (f__recpos+strlen(s)+2 >= L_len)
00046 #endif
00047                         nl_donewrec();
00048                 while(*s)
00049                         PUT(*s++);
00050                 PUT(' ');
00051                 PUT('=');
00052                 number = (dims = v->dims) ? dims + 1 : &one;
00053                 type = v->type;
00054                 if (type < 0) {
00055                         size = -type;
00056                         type = TYCHAR;
00057                         }
00058                 else
00059                         size = f__typesize[type];
00060                 l_write(number, v->addr, size, type);
00061                 if (vd < vde) {
00062                         if (f__recpos+2 >= L_len)
00063                                 nl_donewrec();
00064                         PUT(',');
00065                         PUT(' ');
00066                         }
00067                 else if (f__recpos+1 >= L_len)
00068                         nl_donewrec();
00069                 }
00070         f__Aquote = 0;
00071         PUT('/');
00072         }