# include <memory.h>
# include <malloc.h>
# include <stdio.h>
# include <string.h>
# include <rpc/rpc.h>

FILE *fp;
XDR xdrs;

int xdropen_(fname)
char *fname;
{
	if (strlen(fname) == 0) 
	   {printf("xdropen: no filename specified ???\n");return -2;};

	/* open the file and link it to the XDR stream */
	if ((fp = fopen(fname,"w")) == NULL)
	   {printf("xdropen: problem opening the file.\n");return -1;};
        xdrstdio_create(&xdrs, fp, XDR_ENCODE);
	return 0;
}

int xdrclose_()
{
	/* close the file */
	if (fclose(fp)) 
	   {printf("xdrclose: problem closing file.\n");return -1;}
	return 0;
}

int xdrsave_(type,name,m,n,imagf,preal,pimag)
int *type, *m, *n, *imagf;
char *name, *preal, *pimag;
{
int status;

status=savexdr(&xdrs, *type, name, *m, *n, *imagf, preal, pimag);
if (status != 0) printf("savexdr: error writing to file.\n");
return status;

}

# define MATMACHINETYPE 0
# define MAXMATRIXNAMESIZE 64
typedef struct {
     	long	type;
     	long	mrows;
     	long	ncols;
	long	imagf;
	long	namlen;
} Fmatrix;

int		savexdr(xdrs,type,pname,mrows,ncols,imagf,preal,pimag)

/* return -1 in case of write failure
          -2 in case of memory problem
          -3 with invalid type */

XDR		*xdrs;
int		type; 
int		mrows;
int		ncols;
int		imagf;
char		*pname;
char		*preal;
char		*pimag;
{
	int		mn, elmtSize, namlen;
	xdrproc_t	xdr_filter;
	register int	i;
	
	namlen = strlen(pname) + 1;
	mn = mrows * ncols;

	/* estimate element size and set xdr filter */
	if (!(elmtSize = sizeofmattype(type))) return (-3);
	xdr_filter = xdr_mattype(type);

	/* write matrix header, the namlen is written by xdr_bytes with the name */
	if (xdr_int(xdrs, &type)   == FALSE ||
	    xdr_int(xdrs, &mrows)  == FALSE ||
	    xdr_int(xdrs, &ncols)  == FALSE ||
	    xdr_int(xdrs, &imagf)  == FALSE)
		return (-1);
	/* write matrix name */
	if (xdr_bytes(xdrs, &pname, (u_int *)&namlen, MAXMATRIXNAMESIZE) == FALSE)
		return (-1);

	/* write real part */
	for (i = 0; i < mn; i++)
		if (xdr_filter(xdrs, preal+i*elmtSize) == FALSE)
			return(-1);

	/* write imag part */
	if (imagf)
		for (i = 0; i < mn; i++)
			if (xdr_filter(xdrs, pimag+i*elmtSize) == FALSE)
	 			return(-1);

	/* done */
	return (0);
}

/*---------------------------------------------------------------*/

int		loadxdr(xdrs, type, pname, mrows, ncols, imagf, preal, pimag)

/* return -1 in case of read failure
          -2 in case of memory problem
          -3 with invalid type */

XDR 		*xdrs;
int 		*type;
int 		*mrows;
int 		*ncols;
int 		*imagf;
char 		*pname; 
char	 	**preal;
char		**pimag;

{
	Fmatrix		M;
	int		mn, elmtSize;
	xdrproc_t	xdr_filter;
	register int	i;
	/*  int free();  REMOVE CONFLICTING DEFINITION FOR __ALPHA!!*/

	/* get Fmatrix structure from file, the namlen will be read by xdr_bytes */
	if (xdr_long(xdrs, &M.type)   == FALSE ||
	    xdr_long(xdrs, &M.mrows)  == FALSE ||
	    xdr_long(xdrs, &M.ncols)  == FALSE ||
	    xdr_long(xdrs, &M.imagf)  == FALSE)
		return(-1);
	*type  = M.type;
	*mrows = M.mrows;
	*ncols = M.ncols;
	*imagf = M.imagf;
	mn = M.mrows * M.ncols;
	/* estimate element size */
	if (!(elmtSize = sizeofmattype(M.type))) return (-3);
	xdr_filter = xdr_mattype(M.type);

	/* allocate memory */
	if (!(*preal = malloc(mn*elmtSize)))
		return(-2);
	if (M.imagf)
		if (!(*pimag = malloc(mn*elmtSize))) {
			free(*preal);
			return(-2);
		}

	/* get matrix name */
	if (xdr_bytes(xdrs, &pname, (u_int *)&M.namlen, MAXMATRIXNAMESIZE) == FALSE) {
		free(*preal); free(*pimag);
		return (-1);
	}
	/* get real part */
	for (i = 0; i < mn; i++)
		if (xdr_filter(xdrs, (*preal)+i*elmtSize) == FALSE)
			return(-1);

	/* get imag part */
	if (M.imagf)
		for (i = 0; i < mn; i++)
			if (xdr_filter(xdrs, (*pimag)+i*elmtSize) == FALSE)
	 			return(-1);

	/* done */
	return(0);
}

/*---------------------------------------------------------------*/

/* a function to get the element size, returns a null size in case of invalid format */
int		sizeofmattype(type)
# define MATDOUBLE 0
# define MATFLOAT 10
# define MATLONG 20
# define MATSHORT 30
# define MATUSHORT 40

int		type;

{
	switch(type % 100 - type % 10){
		case MATDOUBLE:
			return(sizeof(double));
		case MATFLOAT:
			return(sizeof(float));
		case MATLONG:
			return(sizeof(int));
		case MATSHORT:
			return(sizeof(short));
		case MATUSHORT:
			return(sizeof(unsigned short));
		default:
			return(0);
	}
}

/* a function to get the xdr filter function returns a null pointer in case 
of invalid format */

xdrproc_t	xdr_mattype(type)

int		type;

{
	switch(type % 100 - type % 10){
		case MATDOUBLE:
			return(xdr_double);
		case MATFLOAT:
			return(xdr_float);
		case MATLONG:
			return(xdr_int);
		case MATSHORT:
			return(xdr_short);
		case MATUSHORT:
			return(xdr_u_short);
		default:
			return(NULL);
	}
}
