lang/fortran/lib/libI77/xwsne.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 #include "lio.h"
   4 #include "fmt.h"
   5
   6 x_wsne(a)
   7  cilist *a;
   8 {
   9         Namelist *nl;
  10         char *s;
  11         Vardesc *v, **vd, **vde;
  12         ftnint *number, type;
  13         ftnlen *dims;
  14         ftnlen size;
  15         static ftnint one = 1;
  16         extern ftnlen typesize[];
  17
  18         nl = (Namelist *)a->cifmt;
  19         PUT('&');
  20         for(s = nl->name; *s; s++)
  21                 PUT(*s);
  22         PUT(' ');
  23         vd = nl->vars;
  24         vde = vd + nl->nvars;
  25         while(vd < vde) {
  26                 v = *vd++;
  27                 s = v->name;
  28                 if (recpos+strlen(s)+2 >= L_len)
  29                         (*donewrec)();
  30                 while(*s)
  31                         PUT(*s++);
  32                 PUT(' ');
  33                 PUT('=');
  34                 number = (dims = v->dims) ? dims + 1 : &one;
  35                 type = v->type;
  36                 if (type < 0) {
  37                         size = -type;
  38                         type = TYCHAR;
  39                         }
  40                 else
  41                         size = typesize[type];
  42                 l_write(number, v->addr, size, type);
  43                 if (vd < vde) {
  44                         if (recpos+2 >= L_len)
  45                                 (*donewrec)();
  46                         PUT(',');
  47                         PUT(' ');
  48                         }
  49                 else if (recpos+1 >= L_len)
  50                         (*donewrec)();
  51                 }
  52         PUT('/');
  53         }