#include "err.h"

#include "lio.h"
#include "wsne.h"

#include "lread.h"
#include <string.h>
#include "f2c.h"
#include "fio.h"


int s_wsne(a)
 cilist *a;
{
	int n;
	Namelist *nl;
	char *s;
	Vardesc *v, **vd, **vde;
	ftnint *number, type;
	Long *dims;
	ftnlen size;
	static ftnint one = 1;
	extern int t_putc();
	static ftnlen typesize[] = { 0, 0, sizeof(shortint), sizeof(integer),
				sizeof(real), sizeof(doublereal),
				sizeof(complex), sizeof(doublecomplex),
				sizeof(char) };

	if(!init)
		f_init();
	if((n=c_le(a)))
		return(n);
	reading=0;
	external=1;
	formatted=1;
	putn = t_putc;
	if(curunit->uwrt != 1 && nowwriting(curunit))
		err(a->cierr, errno, "namelist output start");
	nl = (Namelist *)a->cifmt;
	t_putc('&');
	for(s = nl->name; *s; s++)
		t_putc(*s);
	t_putc(' ');
	vd = nl->vars;
	vde = vd + nl->nvars;
	while(vd < vde) {
		v = *vd++;
		s = v->name;
		if (recpos+strlen(s) >= LINE-2) {
			t_putc('\n');
			recpos = 0;
			t_putc(' ');
			}
		while(*s)
			t_putc(*s++);
		t_putc(' ');
		t_putc('=');
		number = (dims = v->dims) ? dims + 1 : &one;
		type = v->type;
		if (type < 0) {
			size = -type;
			type = TYCHAR;
			}
		else
			size = typesize[type];
		l_write(number, v->addr, size, type);
		if (vd < vde) {
			if (recpos >= LINE-2) {
				t_putc('\n');
				recpos = 0;
				t_putc(' ');
				}
			t_putc(',');
			t_putc(' ');
			}
		else if (recpos >= LINE-1) {
			t_putc('\n');
			recpos = 0;
			t_putc(' ');
			}
		}
	t_putc('/');
	return e_wsle();
	}
