#!/bin/sh # to unpack, sh this message in an empty directory PATH=/bin:/usr/bin cat > 24048P03 <<'bigmail CUT HERE............' - -############################### - -LIST1 = copy.o err.o matrixio.o memory.o vecop.o matop.o pxop.o \ - submat.o init.o otherio.o machine.o matlab.o ivecop.o version.o \ - meminfo.o memstat.o -LIST2 = lufactor.o bkpfacto.o chfactor.o qrfactor.o solve.o hsehldr.o \ - givens.o update.o norm.o hessen.o symmeig.o schur.o svd.o fft.o \ - mfunc.o bdfactor.o -LIST3 = sparse.o sprow.o sparseio.o spchfctr.o splufctr.o \ - spbkp.o spswap.o iter0.o itersym.o iternsym.o -ZLIST1 = zmachine.o zcopy.o zmatio.o zmemory.o zvecop.o zmatop.o znorm.o \ - zfunc.o -ZLIST2 = zlufctr.o zsolve.o zmatlab.o zhsehldr.o zqrfctr.o \ - zgivens.o zhessen.o zschur.o - -# they are no longer supported -# if you use them add oldpart to all and sparse -OLDLIST = conjgrad.o lanczos.o arnoldi.o - -ALL_LISTS = $(LIST1) $(LIST2) $(LIST3) $(ZLIST1) $(ZLIST2) $(OLDLIST) - -HBASE = err.h meminfo.h machine.h matrix.h - -HLIST = $(HBASE) iter.h matlab.h matrix2.h oldnames.h sparse.h \ - sparse2.h zmatrix.h zmatrix2.h - -TORTURE = torture.o sptort.o ztorture.o memtort.o itertort.o \ - mfuntort.o iotort.o - -OTHERS = dmacheps.c extras.c fmacheps.c maxint.c makefile.in \ - README configure configure.in machine.h.in copyright \ - tutorial.c tutadv.c rk4.dat ls.dat makefile $(FLIST) - - -# Different configurations -all: part1 part2 part3 zpart1 zpart2 -basic: part1 part2 -sparse: part1 part2 part3 -complex: part1 part2 zpart1 zpart2 - - -$(LIST1): $(HBASE) -part1: $(LIST1) - ar ru meschach.a $(LIST1); $(RANLIB) meschach.a - -$(LIST2): $(HBASE) matrix2.h -part2: $(LIST2) - ar ru meschach.a $(LIST2); $(RANLIB) meschach.a - -$(LIST3): $(HBASE) sparse.h sparse2.h -part3: $(LIST3) - ar ru meschach.a $(LIST3); $(RANLIB) meschach.a - -$(ZLIST1): $(HBASDE) zmatrix.h -zpart1: $(ZLIST1) - ar ru meschach.a $(ZLIST1); ranlib meschach.a - -$(ZLIST2): $(HBASE) zmatrix.h zmatrix2.h -zpart2: $(ZLIST2) - ar ru meschach.a $(ZLIST2); ranlib meschach.a - -$(OLDLIST): $(HBASE) sparse.h sparse2.h -oldpart: $(OLDLIST) - ar ru meschach.a $(OLDLIST); ranlib meschach.a - - - -####################################### - -tar: - - /bin/rm -f $(MES_PAK).tar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(TAR) cvf $(MES_PAK).tar \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - -# use this only for PC machines -msdos-zip: - - /bin/rm -f $(MES_PAK).zip - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(ZIP) $(MES_PAK).zip \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - - -fullshar: - - /bin/rm -f $(MES_PAK).shar; - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC > $(MES_PAK).shar - -shar: - - /bin/rm -f meschach1.shar meschach2.shar meschach3.shar \ - meschach4.shar oldmeschach.shar meschach0.shar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(LIST1) | sed -e 's/\.o/.c/g'` > meschach1.shar - $(SHAR) `echo $(LIST2) | sed -e 's/\.o/.c/g'` > meschach2.shar - $(SHAR) `echo $(LIST3) | sed -e 's/\.o/.c/g'` > meschach3.shar - $(SHAR) `echo $(ZLIST1) | sed -e 's/\.o/.c/g'` \ - `echo $(ZLIST2) | sed -e 's/\.o/.c/g'` > meschach4.shar - $(SHAR) `echo $(OLDLIST) | sed -e 's/\.o/.c/g'` > oldmeschach.shar - $(SHAR) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) DOC MACHINES > meschach0.shar - -list: - /bin/rm -f $(FLIST) - ls -lR `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) MACHINES DOC \ - |awk '/^$$/ {print};/^[-d]/ {printf("%s %s %10d %s %s %s %s\n", \ - $$1,$$2,$$5,$$6,$$7,$$8,$$9)}; /^[^-d]/ {print}' \ - > $(FLIST) - - - -clean: - /bin/rm -f *.o core asx5213a.mat iotort.dat - -cleanup: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - -alltorture: torture sptort ztorture memtort itertort mfuntort iotort - -torture:torture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o torture torture.o \ - meschach.a $(LIBS) -sptort:sptort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o sptort sptort.o \ - meschach.a $(LIBS) -memtort: memtort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o memtort memtort.o \ - meschach.a $(LIBS) -ztorture:ztorture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o ztorture ztorture.o \ - meschach.a $(LIBS) -itertort: itertort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o itertort itertort.o \ - meschach.a $(LIBS) - -iotort: iotort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o iotort iotort.o \ - meschach.a $(LIBS) -mfuntort: mfuntort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o mfuntort mfuntort.o \ - meschach.a $(LIBS) -tstmove: tstmove.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstmove tstmove.o \ - meschach.a $(LIBS) -tstpxvec: tstpxvec.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstpxvec tstpxvec.o \ - meschach.a $(LIBS) - //GO.SYSIN DD MACHINES/Linux/makefile echo MACHINES/Linux/machine.h 1>&2 sed >MACHINES/Linux/machine.h <<'//GO.SYSIN DD MACHINES/Linux/machine.h' 's/^-//' -/* machine.h. Generated automatically by configure. */ -/* Any machine specific stuff goes here */ -/* Add details necessary for your own installation here! */ - -/* This is for use with "configure" -- if you are not using configure - then use machine.van for the "vanilla" version of machine.h */ - -/* Note special macros: ANSI_C (ANSI C syntax) - SEGMENTED (segmented memory machine e.g. MS-DOS) - MALLOCDECL (declared if malloc() etc have - been declared) */ - -/* #undef const */ - -/* #undef MALLOCDECL */ -#define NOT_SEGMENTED 1 -/* #undef HAVE_COMPLEX_H */ -#define HAVE_MALLOC_H 1 -#define STDC_HEADERS 1 -#define HAVE_BCOPY 1 -#define HAVE_BZERO 1 -#define CHAR0ISDBL0 1 -/* #undef WORDS_BIGENDIAN */ -#define U_INT_DEF 1 -#define VARARGS 1 - - -/* for basic or larger versions */ -#define COMPLEX 1 -#define SPARSE 1 - -/* for loop unrolling */ -/* #undef VUNROLL */ -/* #undef MUNROLL */ - -/* for segmented memory */ -#ifndef NOT_SEGMENTED -#define SEGMENTED -#endif - -/* if the system has malloc.h */ -#ifdef HAVE_MALLOC_H -#define MALLOCDECL 1 -#include -#endif - -/* any compiler should have this header */ -/* if not, change it */ -#include - - -/* Check for ANSI C memmove and memset */ -#ifdef STDC_HEADERS - -/* standard copy & zero functions */ -#define MEM_COPY(from,to,size) memmove((to),(from),(size)) -#define MEM_ZERO(where,size) memset((where),'\0',(size)) - -#ifndef ANSI_C -#define ANSI_C 1 -#endif - -#endif - -/* standard headers */ -#ifdef ANSI_C -#include -#include -#include -#include -#endif - - -/* if have bcopy & bzero and no alternatives yet known, use them */ -#ifdef HAVE_BCOPY -#ifndef MEM_COPY -/* nonstandard copy function */ -#define MEM_COPY(from,to,size) bcopy((char *)(from),(char *)(to),(int)(size)) -#endif -#endif - -#ifdef HAVE_BZERO -#ifndef MEM_ZERO -/* nonstandard zero function */ -#define MEM_ZERO(where,size) bzero((char *)(where),(int)(size)) -#endif -#endif - -/* if the system has complex.h */ -#ifdef HAVE_COMPLEX_H -#include -#endif - -/* If prototypes are available & ANSI_C not yet defined, then define it, - but don't include any header files as the proper ANSI C headers - aren't here */ -#define HAVE_PROTOTYPES 1 -#ifdef HAVE_PROTOTYPES -#ifndef ANSI_C -#define ANSI_C 1 -#endif -#endif - -/* floating point precision */ - -/* you can choose single, double or long double (if available) precision */ - -#define FLOAT 1 -#define DOUBLE 2 -#define LONG_DOUBLE 3 - -/* #undef REAL_FLT */ -/* #undef REAL_DBL */ - -/* if nothing is defined, choose double precision */ -#ifndef REAL_DBL -#ifndef REAL_FLT -#define REAL_DBL 1 -#endif -#endif - -/* single precision */ -#ifdef REAL_FLT -#define Real float -#define LongReal float -#define REAL FLOAT -#define LONGREAL FLOAT -#endif - -/* double precision */ -#ifdef REAL_DBL -#define Real double -#define LongReal double -#define REAL DOUBLE -#define LONGREAL DOUBLE -#endif - - -/* machine epsilon or unit roundoff error */ -/* This is correct on most IEEE Real precision systems */ -#ifdef DBL_EPSILON -#if REAL == DOUBLE -#define MACHEPS DBL_EPSILON -#elif REAL == FLOAT -#define MACHEPS FLT_EPSILON -#elif REAL == LONGDOUBLE -#define MACHEPS LDBL_EPSILON -#endif -#endif - -#define F_MACHEPS 1.19209e-07 -#define D_MACHEPS 2.22045e-16 - -#ifndef MACHEPS -#if REAL == DOUBLE -#define MACHEPS D_MACHEPS -#elif REAL == FLOAT -#define MACHEPS F_MACHEPS -#elif REAL == LONGDOUBLE -#define MACHEPS D_MACHEPS -#endif -#endif - -/* #undef M_MACHEPS */ - -/******************** -#ifdef DBL_EPSILON -#define MACHEPS DBL_EPSILON -#endif -#ifdef M_MACHEPS -#ifndef MACHEPS -#define MACHEPS M_MACHEPS -#endif -#endif -********************/ - -#define M_MAX_INT 2147483647 -#ifdef M_MAX_INT -#ifndef MAX_RAND -#define MAX_RAND ((double)(M_MAX_INT)) -#endif -#endif - -/* for non-ANSI systems */ -#ifndef HUGE_VAL -#define HUGE_VAL HUGE -#endif - - -#ifdef ANSI_C -extern int isatty(int); -#endif - //GO.SYSIN DD MACHINES/Linux/machine.h mkdir MACHINES/SGI echo MACHINES/SGI/machine.h 1>&2 sed >MACHINES/SGI/machine.h <<'//GO.SYSIN DD MACHINES/SGI/machine.h' 's/^-//' -/* machine.h. Generated automatically by configure. */ -/* Any machine specific stuff goes here */ -/* Add details necessary for your own installation here! */ - -/* RCS id: $Id: m5,v 1.1.1.1 1999/04/14 14:16:22 borland Exp $ */ - -/* This is for use with "configure" -- if you are not using configure - then use machine.van for the "vanilla" version of machine.h */ - -/* Note special macros: ANSI_C (ANSI C syntax) - SEGMENTED (segmented memory machine e.g. MS-DOS) - MALLOCDECL (declared if malloc() etc have - been declared) */ - -/* #undef const */ - -/* #undef MALLOCDECL */ -#define NOT_SEGMENTED 1 -#define HAVE_MEMORY_H 1 -/* #undef HAVE_COMPLEX_H */ -#define HAVE_MALLOC_H 1 -#define STDC_HEADERS 1 -#define HAVE_BCOPY 1 -#define HAVE_BZERO 1 -#define CHAR0ISDBL0 1 -#define WORDS_BIGENDIAN 1 -/*#undef U_INT_DEF */ -#define U_INT_DEF -#define VARARGS 1 -#define HAVE_PROTOTYPES 1 -/* #undef HAVE_PROTOTYPES_IN_STRUCT */ - -/* for inclusion into C++ files */ -#ifdef __cplusplus -#define ANSI_C 1 -#ifndef HAVE_PROTOTYPES -#define HAVE_PROTOTYPES 1 -#endif -#ifndef HAVE_PROTOTYPES_IN_STRUCT -#define HAVE_PROTOTYPES_IN_STRUCT 1 -#endif -#endif /* __cplusplus */ - -/* example usage: VEC *PROTO(v_get,(int dim)); */ -#ifdef HAVE_PROTOTYPES -#define PROTO(name,args) name args -#else -#define PROTO(name,args) name() -#endif /* HAVE_PROTOTYPES */ -#ifdef HAVE_PROTOTYPES_IN_STRUCT -/* PROTO_() is to be used instead of PROTO() in struct's and typedef's */ -#define PROTO_(name,args) name args -#else -#define PROTO_(name,args) name() -#endif /* HAVE_PROTOTYPES_IN_STRUCT */ - -/* for basic or larger versions */ -#define COMPLEX 1 -#define SPARSE 1 - -/* for loop unrolling */ -/* #undef VUNROLL */ -/* #undef MUNROLL */ - -/* for segmented memory */ -#ifndef NOT_SEGMENTED -#define SEGMENTED -#endif - -/* if the system has malloc.h */ -#ifdef HAVE_MALLOC_H -#define MALLOCDECL 1 -#include -#endif - -/* any compiler should have this header */ -/* if not, change it */ -#include - - -/* Check for ANSI C memmove and memset */ -#ifdef STDC_HEADERS - -/* standard copy & zero functions */ -#define MEM_COPY(from,to,size) memmove((to),(from),(size)) -#define MEM_ZERO(where,size) memset((where),'\0',(size)) - -#ifndef ANSI_C -#define ANSI_C 1 -#endif - -#endif - -/* standard headers */ -#ifdef ANSI_C -#include -#include -#include -#include -#endif - - -/* if have bcopy & bzero and no alternatives yet known, use them */ -#ifdef HAVE_BCOPY -#ifndef MEM_COPY -/* nonstandard copy function */ -#define MEM_COPY(from,to,size) bcopy((char *)(from),(char *)(to),(int)(size)) -#endif -#endif - -#ifdef HAVE_BZERO -#ifndef MEM_ZERO -/* nonstandard zero function */ -#define MEM_ZERO(where,size) bzero((char *)(where),(int)(size)) -#endif -#endif - -/* if the system has complex.h */ -#ifdef HAVE_COMPLEX_H -#include -#endif - -/* If prototypes are available & ANSI_C not yet defined, then define it, - but don't include any header files as the proper ANSI C headers - aren't here */ -#ifdef HAVE_PROTOTYPES -#ifndef ANSI_C -#define ANSI_C 1 -#endif -#endif - -/* floating point precision */ - -/* you can choose single, double or long double (if available) precision */ - -#define FLOAT 1 -#define DOUBLE 2 -#define LONG_DOUBLE 3 - -#define REAL_FLT 1 -/* #undef REAL_DBL */ - -/* if nothing is defined, choose double precision */ -#ifndef REAL_DBL -#ifndef REAL_FLT -#define REAL_DBL 1 -#endif -#endif - -/* single precision */ -#ifdef REAL_FLT -#define Real float -#define LongReal float -#define REAL FLOAT -#define LONGREAL FLOAT -#endif - -/* double precision */ -#ifdef REAL_DBL -#define Real double -#define LongReal double -#define REAL DOUBLE -#define LONGREAL DOUBLE -#endif - - -/* machine epsilon or unit roundoff error */ -/* This is correct on most IEEE Real precision systems */ -#ifdef DBL_EPSILON -#if REAL == DOUBLE -#define MACHEPS DBL_EPSILON -#elif REAL == FLOAT -#define MACHEPS FLT_EPSILON -#elif REAL == LONGDOUBLE -#define MACHEPS LDBL_EPSILON -#endif -#endif - -#define F_MACHEPS 1.19209e-07 -#define D_MACHEPS 2.22045e-16 - -#ifndef MACHEPS -#if REAL == DOUBLE -#define MACHEPS D_MACHEPS -#elif REAL == FLOAT -#define MACHEPS F_MACHEPS -#elif REAL == LONGDOUBLE -#define MACHEPS D_MACHEPS -#endif -#endif - -/* #undef M_MACHEPS */ - -/******************** -#ifdef DBL_EPSILON -#define MACHEPS DBL_EPSILON -#endif -#ifdef M_MACHEPS -#ifndef MACHEPS -#define MACHEPS M_MACHEPS -#endif -#endif -********************/ - -#define M_MAX_INT 2147483647 -#ifdef M_MAX_INT -#ifndef MAX_RAND -#define MAX_RAND ((double)(M_MAX_INT)) -#endif -#endif - -/* for non-ANSI systems */ -#ifndef HUGE_VAL -#define HUGE_VAL HUGE -#else -#undef HUGE -#define HUGE HUGE_VAL -#endif - - -#ifdef ANSI_C -extern int isatty(int); -#endif - //GO.SYSIN DD MACHINES/SGI/machine.h echo MACHINES/SGI/makefile 1>&2 sed >MACHINES/SGI/makefile <<'//GO.SYSIN DD MACHINES/SGI/makefile' 's/^-//' -# Generated automatically from makefile.in by configure. -# -# Makefile for Meschach via autoconf -# -# Copyright (C) David Stewart & Zbigniew Leyk 1993 -# -# $Id: m5,v 1.1.1.1 1999/04/14 14:16:22 borland Exp $ -# - -srcdir = . -VPATH = . - -CC = cc - -DEFS = -DHAVE_CONFIG_H -LIBS = -lm -RANLIB = ranlib - - -CFLAGS = -O - - -.c.o: - $(CC) -c $(CFLAGS) $(DEFS) $< - -SHELL = /bin/sh -MES_PAK = mesch12b -TAR = tar -SHAR = stree -u -ZIP = zip -r -l -FLIST = FILELIST - -############################### - -LIST1 = copy.o err.o matrixio.o memory.o vecop.o matop.o pxop.o \ - submat.o init.o otherio.o machine.o matlab.o ivecop.o version.o \ - meminfo.o memstat.o -LIST2 = lufactor.o bkpfacto.o chfactor.o qrfactor.o solve.o hsehldr.o \ - givens.o update.o norm.o hessen.o symmeig.o schur.o svd.o fft.o \ - mfunc.o bdfactor.o -LIST3 = sparse.o sprow.o sparseio.o spchfctr.o splufctr.o \ - spbkp.o spswap.o iter0.o itersym.o iternsym.o -ZLIST1 = zmachine.o zcopy.o zmatio.o zmemory.o zvecop.o zmatop.o znorm.o \ - zfunc.o -ZLIST2 = zlufctr.o zsolve.o zmatlab.o zhsehldr.o zqrfctr.o \ - zgivens.o zhessen.o zschur.o - -# they are no longer supported -# if you use them add oldpart to all and sparse -OLDLIST = conjgrad.o lanczos.o arnoldi.o - -ALL_LISTS = $(LIST1) $(LIST2) $(LIST3) $(ZLIST1) $(ZLIST2) $(OLDLIST) - -HBASE = err.h meminfo.h machine.h matrix.h - -HLIST = $(HBASE) iter.h matlab.h matrix2.h oldnames.h sparse.h \ - sparse2.h zmatrix.h zmatrix2.h - -TORTURE = torture.o sptort.o ztorture.o memtort.o itertort.o \ - mfuntort.o iotort.o - -OTHERS = dmacheps.c extras.c fmacheps.c maxint.c makefile.in \ - README configure configure.in machine.h.in copyright \ - tutorial.c tutadv.c rk4.dat ls.dat makefile $(FLIST) - - -# Different configurations -# the dependencies **between** the parts are for dmake -all: part1 part2 part3 zpart1 zpart2 -part2: part1 -part3: part2 -basic: part1 part2 -sparse: part1 part2 part3 -zpart2: zpart1 -complex: part1 part2 zpart1 zpart2 - - -$(LIST1): $(HBASE) -part1: $(LIST1) - ar ru meschach.a $(LIST1) - $(RANLIB) meschach.a - -$(LIST2): $(HBASE) matrix2.h -part2: $(LIST2) - ar ru meschach.a $(LIST2) - $(RANLIB) meschach.a - -$(LIST3): $(HBASE) sparse.h sparse2.h -part3: $(LIST3) - ar ru meschach.a $(LIST3) - $(RANLIB) meschach.a - -$(ZLIST1): $(HBASDE) zmatrix.h -zpart1: $(ZLIST1) - ar ru meschach.a $(ZLIST1) - $(RANLIB) meschach.a - -$(ZLIST2): $(HBASE) zmatrix.h zmatrix2.h -zpart2: $(ZLIST2) - ar ru meschach.a $(ZLIST2) - $(RANLIB) meschach.a - -$(OLDLIST): $(HBASE) sparse.h sparse2.h -oldpart: $(OLDLIST) - ar ru meschach.a $(OLDLIST) - $(RANLIB) meschach.a - - - -####################################### - -tar: - - /bin/rm -f $(MES_PAK).tar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(TAR) cvf $(MES_PAK).tar \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - -# use this only for PC machines -msdos-zip: - - /bin/rm -f $(MES_PAK).zip - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(ZIP) $(MES_PAK).zip \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - - -fullshar: - - /bin/rm -f $(MES_PAK).shar; - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC > $(MES_PAK).shar - -shar: - - /bin/rm -f meschach1.shar meschach2.shar meschach3.shar \ - meschach4.shar oldmeschach.shar meschach0.shar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(LIST1) | sed -e 's/\.o/.c/g'` > meschach1.shar - $(SHAR) `echo $(LIST2) | sed -e 's/\.o/.c/g'` > meschach2.shar - $(SHAR) `echo $(LIST3) | sed -e 's/\.o/.c/g'` > meschach3.shar - $(SHAR) `echo $(ZLIST1) | sed -e 's/\.o/.c/g'` \ - `echo $(ZLIST2) | sed -e 's/\.o/.c/g'` > meschach4.shar - $(SHAR) `echo $(OLDLIST) | sed -e 's/\.o/.c/g'` > oldmeschach.shar - $(SHAR) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) DOC MACHINES > meschach0.shar - -list: - /bin/rm -f $(FLIST) - ls -lR `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) MACHINES DOC \ - |awk '/^$$/ {print};/^[-d]/ {printf("%s %s %10d %s %s %s %s\n", \ - $$1,$$2,$$5,$$6,$$7,$$8,$$9)}; /^[^-d]/ {print}' \ - > $(FLIST) - - - -clean: - /bin/rm -f *.o core asx5213a.mat iotort.dat - -cleanup: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - -realclean: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - /bin/rm -f torture sptort ztorture memtort itertort mfuntort iotort - /bin/rm -f makefile machine.h config.status maxint macheps - -alltorture: torture sptort ztorture memtort itertort mfuntort iotort - -torture:torture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o torture torture.o \ - meschach.a $(LIBS) -sptort:sptort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o sptort sptort.o \ - meschach.a $(LIBS) -memtort: memtort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o memtort memtort.o \ - meschach.a $(LIBS) -ztorture:ztorture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o ztorture ztorture.o \ - meschach.a $(LIBS) -itertort: itertort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o itertort itertort.o \ - meschach.a $(LIBS) - -iotort: iotort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o iotort iotort.o \ - meschach.a $(LIBS) -mfuntort: mfuntort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o mfuntort mfuntort.o \ - meschach.a $(LIBS) -tstmove: tstmove.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstmove tstmove.o \ - meschach.a $(LIBS) -tstpxvec: tstpxvec.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstpxvec tstpxvec.o \ - meschach.a $(LIBS) - //GO.SYSIN DD MACHINES/SGI/makefile mkdir MACHINES/Cray echo MACHINES/Cray/machine.h 1>&2 sed >MACHINES/Cray/machine.h <<'//GO.SYSIN DD MACHINES/Cray/machine.h' 's/^-//' -/* machine.h. Generated automatically by configure. */ -/* Any machine specific stuff goes here */ -/* Add details necessary for your own installation here! */ - -/* RCS id: $Id: m5,v 1.1.1.1 1999/04/14 14:16:22 borland Exp $ */ - -/* This is for use with "configure" -- if you are not using configure - then use machine.van for the "vanilla" version of machine.h */ - -/* Note special macros: ANSI_C (ANSI C syntax) - SEGMENTED (segmented memory machine e.g. MS-DOS) - MALLOCDECL (declared if malloc() etc have - been declared) */ - -#include -#define const - -/* #undef MALLOCDECL */ -#define NOT_SEGMENTED 1 -#define HAVE_MEMORY_H 1 -#define HAVE_COMPLEX_H 1 -#define HAVE_MALLOC_H 1 -#define STDC_HEADERS 1 -#define HAVE_BCOPY 1 -#define HAVE_BZERO 1 -#define CHAR0ISDBL0 1 -#define WORDS_BIGENDIAN 1 -/* #undef U_INT_DEF */ -#define VARARGS 1 -#define HAVE_PROTOTYPES 1 -/* #undef HAVE_PROTOTYPES_IN_STRUCT */ - -/* for inclusion into C++ files */ -#ifdef __cplusplus -#define ANSI_C 1 -#ifndef HAVE_PROTOTYPES -#define HAVE_PROTOTYPES 1 -#endif -#ifndef HAVE_PROTOTYPES_IN_STRUCT -#define HAVE_PROTOTYPES_IN_STRUCT 1 -#endif -#endif /* __cplusplus */ - -/* example usage: VEC *PROTO(v_get,(int dim)); */ -#ifdef HAVE_PROTOTYPES -#define PROTO(name,args) name args -#else -#define PROTO(name,args) name() -#endif /* HAVE_PROTOTYPES */ -#ifdef HAVE_PROTOTYPES_IN_STRUCT -/* PROTO_() is to be used instead of PROTO() in struct's and typedef's */ -#define PROTO_(name,args) name args -#else -#define PROTO_(name,args) name() -#endif /* HAVE_PROTOTYPES_IN_STRUCT */ - -/* for basic or larger versions */ -#define COMPLEX 1 -#define SPARSE 1 - -/* for loop unrolling */ -/* #undef VUNROLL */ -/* #undef MUNROLL */ - -/* for segmented memory */ -#ifndef NOT_SEGMENTED -#define SEGMENTED -#endif - -/* if the system has malloc.h */ -#ifdef HAVE_MALLOC_H -#define MALLOCDECL 1 -#include -#endif - -/* any compiler should have this header */ -/* if not, change it */ -#include - - -/* Check for ANSI C memmove and memset */ -#ifdef STDC_HEADERS - -/* standard copy & zero functions */ -#define MEM_COPY(from,to,size) memmove((to),(from),(size)) -#define MEM_ZERO(where,size) memset((where),'\0',(size)) - -#ifndef ANSI_C -#define ANSI_C 1 -#endif - -#endif - -/* standard headers */ -#ifdef ANSI_C -#include -#include -#include -#include -#endif - - -/* if have bcopy & bzero and no alternatives yet known, use them */ -#ifdef HAVE_BCOPY -#ifndef MEM_COPY -/* nonstandard copy function */ -#define MEM_COPY(from,to,size) bcopy((char *)(from),(char *)(to),(int)(size)) -#endif -#endif - -#ifdef HAVE_BZERO -#ifndef MEM_ZERO -/* nonstandard zero function */ -#define MEM_ZERO(where,size) bzero((char *)(where),(int)(size)) -#endif -#endif - -/* if the system has complex.h */ -#ifdef HAVE_COMPLEX_H -#include -#endif - -/* If prototypes are available & ANSI_C not yet defined, then define it, - but don't include any header files as the proper ANSI C headers - aren't here */ -#ifdef HAVE_PROTOTYPES -#ifndef ANSI_C -#define ANSI_C 1 -#endif -#endif - -/* floating point precision */ - -/* you can choose single, double or long double (if available) precision */ - -#define FLOAT 1 -#define DOUBLE 2 -#define LONG_DOUBLE 3 - -#define REAL_FLT 1 -/* #undef REAL_DBL */ - -/* if nothing is defined, choose double precision */ -#ifndef REAL_DBL -#ifndef REAL_FLT -#define REAL_DBL 1 -#endif -#endif - -/* single precision */ -#ifdef REAL_FLT -#define Real float -#define LongReal float -#define REAL FLOAT -#define LONGREAL FLOAT -#endif - -/* double precision */ -#ifdef REAL_DBL -#define Real double -#define LongReal double -#define REAL DOUBLE -#define LONGREAL DOUBLE -#endif - - -/* machine epsilon or unit roundoff error */ -/* This is correct on most IEEE Real precision systems */ -#ifdef DBL_EPSILON -#if REAL == DOUBLE -#define MACHEPS DBL_EPSILON -#elif REAL == FLOAT -#define MACHEPS FLT_EPSILON -#elif REAL == LONGDOUBLE -#define MACHEPS LDBL_EPSILON -#endif -#endif - -#define F_MACHEPS 7.10543e-15 -#define D_MACHEPS 7.10543e-15 - -#ifndef MACHEPS -#if REAL == DOUBLE -#define MACHEPS D_MACHEPS -#elif REAL == FLOAT -#define MACHEPS F_MACHEPS -#elif REAL == LONGDOUBLE -#define MACHEPS D_MACHEPS -#endif -#endif - -/* #undef M_MACHEPS */ - -/******************** -#ifdef DBL_EPSILON -#define MACHEPS DBL_EPSILON -#endif -#ifdef M_MACHEPS -#ifndef MACHEPS -#define MACHEPS M_MACHEPS -#endif -#endif -********************/ - -#define M_MAX_INT 9223372036854775807 -#ifdef M_MAX_INT -#ifndef MAX_RAND -#define MAX_RAND ((double)(M_MAX_INT)) -#endif -#endif - -/* for non-ANSI systems */ -#ifndef HUGE_VAL -#define HUGE_VAL HUGE -#else -/* #undef HUGE */ -#define HUGE HUGE_VAL -#endif - - -#ifdef ANSI_C -extern int isatty(int); -#endif - //GO.SYSIN DD MACHINES/Cray/machine.h echo MACHINES/Cray/makefile 1>&2 sed >MACHINES/Cray/makefile <<'//GO.SYSIN DD MACHINES/Cray/makefile' 's/^-//' -# Generated automatically from makefile.in by configure. -# -# Makefile for Meschach via autoconf -# -# Copyright (C) David Stewart & Zbigniew Leyk 1993 -# -# $Id: m5,v 1.1.1.1 1999/04/14 14:16:22 borland Exp $ -# - -srcdir = . -VPATH = . - -CC = cc - -DEFS = -DHAVE_CONFIG_H -LIBS = -lm -RANLIB = : - - -CFLAGS = -O - - -.c.o: - $(CC) -c $(CFLAGS) $(DEFS) $< - -SHELL = /bin/sh -MES_PAK = mesch12b -TAR = tar -SHAR = stree -u -ZIP = zip -r -l -FLIST = FILELIST - -############################### - -LIST1 = copy.o err.o matrixio.o memory.o vecop.o matop.o pxop.o \ - submat.o init.o otherio.o machine.o matlab.o ivecop.o version.o \ - meminfo.o memstat.o -LIST2 = lufactor.o bkpfacto.o chfactor.o qrfactor.o solve.o hsehldr.o \ - givens.o update.o norm.o hessen.o symmeig.o schur.o svd.o fft.o \ - mfunc.o bdfactor.o -LIST3 = sparse.o sprow.o sparseio.o spchfctr.o splufctr.o \ - spbkp.o spswap.o iter0.o itersym.o iternsym.o -ZLIST1 = zmachine.o zcopy.o zmatio.o zmemory.o zvecop.o zmatop.o znorm.o \ - zfunc.o -ZLIST2 = zlufctr.o zsolve.o zmatlab.o zhsehldr.o zqrfctr.o \ - zgivens.o zhessen.o zschur.o - -# they are no longer supported -# if you use them add oldpart to all and sparse -OLDLIST = conjgrad.o lanczos.o arnoldi.o - -ALL_LISTS = $(LIST1) $(LIST2) $(LIST3) $(ZLIST1) $(ZLIST2) $(OLDLIST) - -HBASE = err.h meminfo.h machine.h matrix.h - -HLIST = $(HBASE) iter.h matlab.h matrix2.h oldnames.h sparse.h \ - sparse2.h zmatrix.h zmatrix2.h - -TORTURE = torture.o sptort.o ztorture.o memtort.o itertort.o \ - mfuntort.o iotort.o - -OTHERS = dmacheps.c extras.c fmacheps.c maxint.c makefile.in \ - README configure configure.in machine.h.in copyright \ - tutorial.c tutadv.c rk4.dat ls.dat makefile $(FLIST) - - -# Different configurations -# the dependencies **between** the parts are for dmake -all: part1 part2 part3 zpart1 zpart2 ar_create -part2: part1 -part3: part2 -basic: part1 part2 -sparse: part1 part2 part3 -zpart2: zpart1 -complex: part1 part2 zpart1 zpart2 - - -$(LIST1): $(HBASE) -part1: $(LIST1) - ar ru meschach.a $(LIST1) - $(RANLIB) meschach.a - -$(LIST2): $(HBASE) matrix2.h -part2: $(LIST2) - ar ru meschach.a $(LIST2) - $(RANLIB) meschach.a - -$(LIST3): $(HBASE) sparse.h sparse2.h -part3: $(LIST3) - ar ru meschach.a $(LIST3) - $(RANLIB) meschach.a - -$(ZLIST1): $(HBASDE) zmatrix.h -zpart1: $(ZLIST1) - ar ru meschach.a $(ZLIST1) - $(RANLIB) meschach.a - -$(ZLIST2): $(HBASE) zmatrix.h zmatrix2.h -zpart2: $(ZLIST2) - ar ru meschach.a $(ZLIST2) - $(RANLIB) meschach.a - -$(OLDLIST): $(HBASE) sparse.h sparse2.h -oldpart: $(OLDLIST) - ar ru meschach.a $(OLDLIST) - $(RANLIB) meschach.a - - - -####################################### - -tar: - - /bin/rm -f $(MES_PAK).tar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(TAR) cvf $(MES_PAK).tar \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - -# use this only for PC machines -msdos-zip: - - /bin/rm -f $(MES_PAK).zip - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(ZIP) $(MES_PAK).zip \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - - -fullshar: - - /bin/rm -f $(MES_PAK).shar; - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC > $(MES_PAK).shar - -shar: - - /bin/rm -f meschach1.shar meschach2.shar meschach3.shar \ - meschach4.shar oldmeschach.shar meschach0.shar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(LIST1) | sed -e 's/\.o/.c/g'` > meschach1.shar - $(SHAR) `echo $(LIST2) | sed -e 's/\.o/.c/g'` > meschach2.shar - $(SHAR) `echo $(LIST3) | sed -e 's/\.o/.c/g'` > meschach3.shar - $(SHAR) `echo $(ZLIST1) | sed -e 's/\.o/.c/g'` \ - `echo $(ZLIST2) | sed -e 's/\.o/.c/g'` > meschach4.shar - $(SHAR) `echo $(OLDLIST) | sed -e 's/\.o/.c/g'` > oldmeschach.shar - $(SHAR) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) DOC MACHINES > meschach0.shar - -list: - /bin/rm -f $(FLIST) - ls -lR `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) MACHINES DOC \ - |awk '/^$$/ {print};/^[-d]/ {printf("%s %s %10d %s %s %s %s\n", \ - $$1,$$2,$$5,$$6,$$7,$$8,$$9)}; /^[^-d]/ {print}' \ - > $(FLIST) - - - -clean: - /bin/rm -f *.o core asx5213a.mat iotort.dat - -cleanup: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - -realclean: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - /bin/rm -f torture sptort ztorture memtort itertort mfuntort iotort - /bin/rm -f makefile machine.h config.status maxint macheps - -alltorture: torture sptort ztorture memtort itertort mfuntort iotort - -torture:torture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o torture torture.o \ - meschach.a $(LIBS) -sptort:sptort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o sptort sptort.o \ - meschach.a $(LIBS) -memtort: memtort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o memtort memtort.o \ - meschach.a $(LIBS) -ztorture:ztorture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o ztorture ztorture.o \ - meschach.a $(LIBS) -itertort: itertort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o itertort itertort.o \ - meschach.a $(LIBS) - -iotort: iotort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o iotort iotort.o \ - meschach.a $(LIBS) -mfuntort: mfuntort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o mfuntort mfuntort.o \ - meschach.a $(LIBS) -tstmove: tstmove.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstmove tstmove.o \ - meschach.a $(LIBS) -tstpxvec: tstpxvec.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstpxvec tstpxvec.o \ - meschach.a $(LIBS) -ar_create: - rm meschach.a - ar ruv meschach.a $(LIST1) $(LIST2) $(LIST3) \ - $(ZLIST1) $(ZLIST2) $(OLDLIST) //GO.SYSIN DD MACHINES/Cray/makefile echo MACHINES/Cray/patch.1 1>&2 sed >MACHINES/Cray/patch.1 <<'//GO.SYSIN DD MACHINES/Cray/patch.1' 's/^-//' -*** err.h Thu Jan 13 16:38:12 1994 ---- err.h.orig Wed Oct 26 17:56:36 1994 -*************** -*** 129,135 **** - { jmp_buf _save; int _err_num, _old_flag; \ - _old_flag = set_err_flag(EF_SILENT); \ - MEM_COPY(restart,_save,sizeof(jmp_buf)); \ -! if ( (_err_num=setjmp(restart)) == 0 ) \ - { ok_part; \ - set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); } \ ---- 129,136 ---- - { jmp_buf _save; int _err_num, _old_flag; \ - _old_flag = set_err_flag(EF_SILENT); \ - MEM_COPY(restart,_save,sizeof(jmp_buf)); \ -! _err_num=setjmp(restart); \ -! if ( _err_num == 0 ) \ - { ok_part; \ - set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); } \ -*************** -*** 149,155 **** - { jmp_buf _save; int _err_num, _old_flag; \ - _old_flag = set_err_flag(EF_SILENT); \ - MEM_COPY(restart,_save,sizeof(jmp_buf)); \ -! if ( (_err_num=setjmp(restart)) == 0 ) \ - { ok_part; \ - set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); } \ ---- 150,157 ---- - { jmp_buf _save; int _err_num, _old_flag; \ - _old_flag = set_err_flag(EF_SILENT); \ - MEM_COPY(restart,_save,sizeof(jmp_buf)); \ -! _err_num=setjmp(restart); \ -! if ( _err_num == 0 ) \ - { ok_part; \ - set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); } \ -*************** -*** 166,172 **** - { jmp_buf _save; int _err_num, _old_flag; \ - _old_flag = set_err_flag(EF_JUMP); \ - MEM_COPY(restart,_save,sizeof(jmp_buf)); \ -! if ( (_err_num=setjmp(restart)) == 0 ) \ - { ok_part; \ - set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); } \ ---- 168,175 ---- - { jmp_buf _save; int _err_num, _old_flag; \ - _old_flag = set_err_flag(EF_JUMP); \ - MEM_COPY(restart,_save,sizeof(jmp_buf)); \ -! _err_num=setjmp(restart) ;\ -! if ( _err_num == 0 ) \ - { ok_part; \ - set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); } \ //GO.SYSIN DD MACHINES/Cray/patch.1 echo MACHINES/Cray/patch.2 1>&2 sed >MACHINES/Cray/patch.2 <<'//GO.SYSIN DD MACHINES/Cray/patch.2' 's/^-//' -*** iter0.c Mon Jun 20 15:22:36 1994 ---- iter0.c.orig Fri Oct 28 01:49:19 1994 -*************** -*** 103,111 **** - if (lenx > 0) ip->x = v_get(lenx); - else ip->x = (VEC *)NULL; - -! ip->Ax = ip->A_par = NULL; -! ip->ATx = ip->AT_par = NULL; -! ip->Bx = ip->B_par = NULL; - ip->info = iter_std_info; - ip->stop_crit = iter_std_stop_crit; - ip->init_res = 0.0; ---- 103,111 ---- - if (lenx > 0) ip->x = v_get(lenx); - else ip->x = (VEC *)NULL; - -! ip->Ax = NULL; ip->A_par = NULL; -! ip->ATx = NULL; ip->AT_par = NULL; -! ip->Bx = NULL; ip->B_par = NULL; - ip->info = iter_std_info; - ip->stop_crit = iter_std_stop_crit; - ip->init_res = 0.0; //GO.SYSIN DD MACHINES/Cray/patch.2 echo MACHINES/Cray/patch.3 1>&2 sed >MACHINES/Cray/patch.3 <<'//GO.SYSIN DD MACHINES/Cray/patch.3' 's/^-//' -*** zmatrix.h Tue Mar 8 15:50:26 1994 ---- zmatrix.h.orig Fri Oct 28 01:52:48 1994 -*************** -*** 34,39 **** ---- 34,41 ---- - - /* Type definitions for complex vectors and matrices */ - -+ #undef complex -+ #define complex Complex - - /* complex definition */ - typedef struct { //GO.SYSIN DD MACHINES/Cray/patch.3 bigmail CUT HERE............ test -w meschach0.shar && test -r 24048P00 && test -r 24048P01 && test -r 24048P02 && test -r 24048P03 && ( cat 24048P00 >> meschach0.shar; rm 24048P00 cat 24048P01 >> meschach0.shar; rm 24048P01 cat 24048P02 >> meschach0.shar; rm 24048P02 cat 24048P03 >> meschach0.shar; rm 24048P03 ) cat > meschach1.shar <<'bigmail CUT HERE............' # to unbundle, sh this file (in an empty directory) echo copy.c 1>&2 sed >copy.c <<'//GO.SYSIN DD copy.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -static char rcsid[] = "$Id: m5,v 1.1.1.1 1999/04/14 14:16:22 borland Exp $"; -#include -#include "matrix.h" - - - -/* _m_copy -- copies matrix into new area */ -MAT *_m_copy(in,out,i0,j0) -MAT *in,*out; -u_int i0,j0; -{ - u_int i /* ,j */; - - if ( in==MNULL ) - error(E_NULL,"_m_copy"); - if ( in==out ) - return (out); - if ( out==MNULL || out->m < in->m || out->n < in->n ) - out = m_resize(out,in->m,in->n); - - for ( i=i0; i < in->m; i++ ) - MEM_COPY(&(in->me[i][j0]),&(out->me[i][j0]), - (in->n - j0)*sizeof(Real)); - /* for ( j=j0; j < in->n; j++ ) - out->me[i][j] = in->me[i][j]; */ - - return (out); -} - -/* _v_copy -- copies vector into new area */ -VEC *_v_copy(in,out,i0) -VEC *in,*out; -u_int i0; -{ - /* u_int i,j; */ - - if ( in==VNULL ) - error(E_NULL,"_v_copy"); - if ( in==out ) - return (out); - if ( out==VNULL || out->dim < in->dim ) - out = v_resize(out,in->dim); - - MEM_COPY(&(in->ve[i0]),&(out->ve[i0]),(in->dim - i0)*sizeof(Real)); - /* for ( i=i0; i < in->dim; i++ ) - out->ve[i] = in->ve[i]; */ - - return (out); -} - -/* px_copy -- copies permutation 'in' to 'out' */ -PERM *px_copy(in,out) -PERM *in,*out; -{ - /* int i; */ - - if ( in == PNULL ) - error(E_NULL,"px_copy"); - if ( in == out ) - return out; - if ( out == PNULL || out->size != in->size ) - out = px_resize(out,in->size); - - MEM_COPY(in->pe,out->pe,in->size*sizeof(u_int)); - /* for ( i = 0; i < in->size; i++ ) - out->pe[i] = in->pe[i]; */ - - return out; -} - -/* - The .._move() routines are for moving blocks of memory around - within Meschach data structures and for re-arranging matrices, - vectors etc. -*/ - -/* m_move -- copies selected pieces of a matrix - -- moves the m0 x n0 submatrix with top-left cor-ordinates (i0,j0) - to the corresponding submatrix of out with top-left co-ordinates - (i1,j1) - -- out is resized (& created) if necessary */ -MAT *m_move(in,i0,j0,m0,n0,out,i1,j1) -MAT *in, *out; -int i0, j0, m0, n0, i1, j1; -{ - int i; - - if ( ! in ) - error(E_NULL,"m_move"); - if ( i0 < 0 || j0 < 0 || i1 < 0 || j1 < 0 || m0 < 0 || n0 < 0 || - i0+m0 > in->m || j0+n0 > in->n ) - error(E_BOUNDS,"m_move"); - - if ( ! out ) - out = m_resize(out,i1+m0,j1+n0); - else if ( i1+m0 > out->m || j1+n0 > out->n ) - out = m_resize(out,max(out->m,i1+m0),max(out->n,j1+n0)); - - for ( i = 0; i < m0; i++ ) - MEM_COPY(&(in->me[i0+i][j0]),&(out->me[i1+i][j1]), - n0*sizeof(Real)); - - return out; -} - -/* v_move -- copies selected pieces of a vector - -- moves the length dim0 subvector with initial index i0 - to the corresponding subvector of out with initial index i1 - -- out is resized if necessary */ -VEC *v_move(in,i0,dim0,out,i1) -VEC *in, *out; -int i0, dim0, i1; -{ - if ( ! in ) - error(E_NULL,"v_move"); - if ( i0 < 0 || dim0 < 0 || i1 < 0 || - i0+dim0 > in->dim ) - error(E_BOUNDS,"v_move"); - - if ( (! out) || i1+dim0 > out->dim ) - out = v_resize(out,i1+dim0); - - MEM_COPY(&(in->ve[i0]),&(out->ve[i1]),dim0*sizeof(Real)); - - return out; -} - -/* mv_move -- copies selected piece of matrix to a vector - -- moves the m0 x n0 submatrix with top-left co-ordinate (i0,j0) to - the subvector with initial index i1 (and length m0*n0) - -- rows are copied contiguously - -- out is resized if necessary */ -VEC *mv_move(in,i0,j0,m0,n0,out,i1) -MAT *in; -VEC *out; -int i0, j0, m0, n0, i1; -{ - int dim1, i; - - if ( ! in ) - error(E_NULL,"mv_move"); - if ( i0 < 0 || j0 < 0 || m0 < 0 || n0 < 0 || i1 < 0 || - i0+m0 > in->m || j0+n0 > in->n ) - error(E_BOUNDS,"mv_move"); - - dim1 = m0*n0; - if ( (! out) || i1+dim1 > out->dim ) - out = v_resize(out,i1+dim1); - - for ( i = 0; i < m0; i++ ) - MEM_COPY(&(in->me[i0+i][j0]),&(out->ve[i1+i*n0]),n0*sizeof(Real)); - - return out; -} - -/* vm_move -- copies selected piece of vector to a matrix - -- moves the subvector with initial index i0 and length m1*n1 to - the m1 x n1 submatrix with top-left co-ordinate (i1,j1) - -- copying is done by rows - -- out is resized if necessary */ -MAT *vm_move(in,i0,out,i1,j1,m1,n1) -VEC *in; -MAT *out; -int i0, i1, j1, m1, n1; -{ - int dim0, i; - - if ( ! in ) - error(E_NULL,"vm_move"); - if ( i0 < 0 || i1 < 0 || j1 < 0 || m1 < 0 || n1 < 0 || - i0+m1*n1 > in->dim ) - error(E_BOUNDS,"vm_move"); - - if ( ! out ) - out = m_resize(out,i1+m1,j1+n1); - else - out = m_resize(out,max(i1+m1,out->m),max(j1+n1,out->n)); - - dim0 = m1*n1; - for ( i = 0; i < m1; i++ ) - MEM_COPY(&(in->ve[i0+i*n1]),&(out->me[i1+i][j1]),n1*sizeof(Real)); - - return out; -} //GO.SYSIN DD copy.c echo err.c 1>&2 sed >err.c <<'//GO.SYSIN DD err.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Stewart & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* - File with basic error-handling operations - Based on previous version on Zilog - System 8000 setret() etc. - Ported to Pyramid 9810 late 1987 - */ - -static char rcsid[] = "$Id: m5,v 1.1.1.1 1999/04/14 14:16:22 borland Exp $"; - -#include -#include -#include -#include "err.h" - - -#ifdef SYSV -/* AT&T System V */ -#include -#else -/* something else -- assume BSD or ANSI C */ -#include -#endif - - - -#define FALSE 0 -#define TRUE 1 - -#define EF_EXIT 0 -#define EF_ABORT 1 -#define EF_JUMP 2 -#define EF_SILENT 3 - -/* The only error caught in this file! */ -#define E_SIGNAL 16 - -static char *err_mesg[] = -{ "unknown error", /* 0 */ - "sizes of objects don't match", /* 1 */ - "index out of bounds", /* 2 */ - "can't allocate memory", /* 3 */ - "singular matrix", /* 4 */ - "matrix not positive definite", /* 5 */ - "incorrect format input", /* 6 */ - "bad input file/device", /* 7 */ - "NULL objects passed", /* 8 */ - "matrix not square", /* 9 */ - "object out of range", /* 10 */ - "can't do operation in situ for non-square matrix", /* 11 */ - "can't do operation in situ", /* 12 */ - "excessive number of iterations", /* 13 */ - "convergence criterion failed", /* 14 */ - "bad starting value", /* 15 */ - "floating exception", /* 16 */ - "internal inconsistency (data structure)",/* 17 */ - "unexpected end-of-file", /* 18 */ - "shared vectors (cannot release them)", /* 19 */ - "negative argument", /* 20 */ - "cannot overwrite object", /* 21 */ - "breakdown in iterative method" /* 22 */ - }; - -#define MAXERR (sizeof(err_mesg)/sizeof(char *)) - -static char *warn_mesg[] = { - "unknown warning", /* 0 */ - "wrong type number (use macro TYPE_*)", /* 1 */ - "no corresponding mem_stat_mark", /* 2 */ - "computed norm of a residual is less than 0", /* 3 */ - "resizing a shared vector" /* 4 */ -}; - -#define MAXWARN (sizeof(warn_mesg)/sizeof(char *)) - - - -#define MAX_ERRS 100 - -jmp_buf restart; - - -/* array of pointers to lists of errors */ - -typedef struct { - char **listp; /* pointer to a list of errors */ - unsigned len; /* length of the list */ - unsigned warn; /* =FALSE - errors, =TRUE - warnings */ -} Err_list; - -static Err_list err_list[ERR_LIST_MAX_LEN] = { - {err_mesg,MAXERR,FALSE}, /* basic errors list */ - {warn_mesg,MAXWARN,TRUE} /* basic warnings list */ -}; - - -static int err_list_end = 2; /* number of elements in err_list */ - -/* attach a new list of errors pointed by err_ptr - or change a previous one; - list_len is the number of elements in the list; - list_num is the list number; - warn == FALSE - errors (stop the program), - warn == TRUE - warnings (continue the program); - Note: lists numbered 0 and 1 are attached automatically, - you do not need to do it - */ -int err_list_attach(list_num, list_len,err_ptr,warn) -int list_num, list_len, warn; -char **err_ptr; -{ - if (list_num < 0 || list_len <= 0 || - err_ptr == (char **)NULL) - return -1; - - if (list_num >= ERR_LIST_MAX_LEN) { - fprintf(stderr,"\n file \"%s\": %s %s\n", - "err.c","increase the value of ERR_LIST_MAX_LEN", - "in matrix.h and zmatdef.h"); - if ( ! isatty(fileno(stdout)) ) - fprintf(stderr,"\n file \"%s\": %s %s\n", - "err.c","increase the value of ERR_LIST_MAX_LEN", - "in matrix.h and zmatdef.h"); - printf("Exiting program\n"); - exit(0); - } - - if (err_list[list_num].listp != (char **)NULL && - err_list[list_num].listp != err_ptr) - free((char *)err_list[list_num].listp); - err_list[list_num].listp = err_ptr; - err_list[list_num].len = list_len; - err_list[list_num].warn = warn; - err_list_end = list_num+1; - - return list_num; -} - - -/* release the error list numbered list_num */ -int err_list_free(list_num) -int list_num; -{ - if (list_num < 0 || list_num >= err_list_end) return -1; - if (err_list[list_num].listp != (char **)NULL) { - err_list[list_num].listp = (char **)NULL; - err_list[list_num].len = 0; - err_list[list_num].warn = 0; - } - return 0; -} - - -/* check if list_num is attached; - return FALSE if not; - return TRUE if yes - */ -int err_is_list_attached(list_num) -int list_num; -{ - if (list_num < 0 || list_num >= err_list_end) - return FALSE; - - if (err_list[list_num].listp != (char **)NULL) - return TRUE; - - return FALSE; -} - -/* other local variables */ - -static int err_flag = EF_EXIT, num_errs = 0, cnt_errs = 1; - -/* set_err_flag -- sets err_flag -- returns old err_flag */ -int set_err_flag(flag) -int flag; -{ - int tmp; - - tmp = err_flag; - err_flag = flag; - return tmp; -} - -/* count_errs -- sets cnt_errs (TRUE/FALSE) & returns old value */ -int count_errs(flag) -int flag; -{ - int tmp; - - tmp = cnt_errs; - cnt_errs = flag; - return tmp; -} - -/* ev_err -- reports error (err_num) in file "file" at line "line_num" and - returns to user error handler; - list_num is an error list number (0 is the basic list - pointed by err_mesg, 1 is the basic list of warnings) - */ -int ev_err(file,err_num,line_num,fn_name,list_num) -char *file, *fn_name; -int err_num, line_num,list_num; -{ - int num; - - if ( err_num < 0 ) err_num = 0; - - if (list_num < 0 || list_num >= err_list_end || - err_list[list_num].listp == (char **)NULL) { - fprintf(stderr, - "\n Not (properly) attached list of errors: list_num = %d\n", - list_num); - fprintf(stderr," Call \"err_list_attach\" in your program\n"); - if ( ! isatty(fileno(stdout)) ) { - fprintf(stderr, - "\n Not (properly) attached list of errors: list_num = %d\n", - list_num); - fprintf(stderr," Call \"err_list_attach\" in your program\n"); - } - printf("\nExiting program\n"); - exit(0); - } - - num = err_num; - if ( num >= err_list[list_num].len ) num = 0; - - if ( cnt_errs && ++num_errs >= MAX_ERRS ) /* too many errors */ - { - fprintf(stderr,"\n\"%s\", line %d: %s in function %s()\n", - file,line_num,err_list[list_num].listp[num], - isascii(*fn_name) ? fn_name : "???"); - if ( ! isatty(fileno(stdout)) ) - fprintf(stdout,"\n\"%s\", line %d: %s in function %s()\n", - file,line_num,err_list[list_num].listp[num], - isascii(*fn_name) ? fn_name : "???"); - printf("Sorry, too many errors: %d\n",num_errs); - printf("Exiting program\n"); - exit(0); - } - if ( err_list[list_num].warn ) - switch ( err_flag ) - { - case EF_SILENT: break; - default: - fprintf(stderr,"\n\"%s\", line %d: %s in function %s()\n\n", - file,line_num,err_list[list_num].listp[num], - isascii(*fn_name) ? fn_name : "???"); - if ( ! isatty(fileno(stdout)) ) - fprintf(stdout,"\n\"%s\", line %d: %s in function %s()\n\n", - file,line_num,err_list[list_num].listp[num], - isascii(*fn_name) ? fn_name : "???"); - break; - } - else - switch ( err_flag ) - { - case EF_SILENT: - longjmp(restart,(err_num==0)? -1 : err_num); - break; - case EF_ABORT: - fprintf(stderr,"\n\"%s\", line %d: %s in function %s()\n", - file,line_num,err_list[list_num].listp[num], - isascii(*fn_name) ? fn_name : "???"); - if ( ! isatty(fileno(stdout)) ) - fprintf(stdout,"\n\"%s\", line %d: %s in function %s()\n", - file,line_num,err_list[list_num].listp[num], - isascii(*fn_name) ? fn_name : "???"); - abort(); - break; - case EF_JUMP: - fprintf(stderr,"\n\"%s\", line %d: %s in function %s()\n", - file,line_num,err_list[list_num].listp[num], - isascii(*fn_name) ? fn_name : "???"); - if ( ! isatty(fileno(stdout)) ) - fprintf(stdout,"\n\"%s\", line %d: %s in function %s()\n", - file,line_num,err_list[list_num].listp[num], - isascii(*fn_name) ? fn_name : "???"); - longjmp(restart,(err_num==0)? -1 : err_num); - break; - default: - fprintf(stderr,"\n\"%s\", line %d: %s in function %s()\n\n", - file,line_num,err_list[list_num].listp[num], - isascii(*fn_name) ? fn_name : "???"); - if ( ! isatty(fileno(stdout)) ) - fprintf(stdout,"\n\"%s\", line %d: %s in function %s()\n\n", - file,line_num,err_list[list_num].listp[num], - isascii(*fn_name) ? fn_name : "???"); - - break; - } - - /* ensure exit if fall through */ - if ( ! err_list[list_num].warn ) exit(0); - - return 0; -} - -/* float_error -- catches floating arithmetic signals */ -static void float_error(num) -int num; -{ - signal(SIGFPE,float_error); - /* fprintf(stderr,"SIGFPE: signal #%d\n",num); */ - /* fprintf(stderr,"errno = %d\n",errno); */ - ev_err("???.c",E_SIGNAL,0,"???",0); -} - -/* catch_signal -- sets up float_error() to catch SIGFPE's */ -void catch_FPE() -{ - signal(SIGFPE,float_error); -} - - //GO.SYSIN DD err.c echo matrixio.c 1>&2 sed >matrixio.c <<'//GO.SYSIN DD matrixio.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* 1.6 matrixio.c 11/25/87 */ - - -#include -#include -#include "matrix.h" - -static char rcsid[] = "$Id: m5,v 1.1.1.1 1999/04/14 14:16:22 borland Exp $"; - - -/* local variables */ -static char line[MAXLINE]; - - -/************************************************************************** - Input routines - **************************************************************************/ -/* skipjunk -- skips white spaces and strings of the form #....\n - Here .... is a comment string */ -int skipjunk(fp) -FILE *fp; -{ - int c; - - for ( ; ; ) /* forever do... */ - { - /* skip blanks */ - do - c = getc(fp); - while ( isspace(c) ); - - /* skip comments (if any) */ - if ( c == '#' ) - /* yes it is a comment (line) */ - while ( (c=getc(fp)) != '\n' ) - ; - else - { - ungetc(c,fp); - break; - } - } - return 0; -} - -MAT *m_finput(fp,a) -FILE *fp; -MAT *a; -{ - MAT *im_finput(),*bm_finput(); - - if ( isatty(fileno(fp)) ) - return im_finput(fp,a); - else - return bm_finput(fp,a); -} - -/* im_finput -- interactive input of matrix */ -MAT *im_finput(fp,mat) -FILE *fp; -MAT *mat; -{ - char c; - u_int i, j, m, n, dynamic; - /* dynamic set to TRUE if memory allocated here */ - - /* get matrix size */ - if ( mat != (MAT *)NULL && mat->mnm; n = mat->n; dynamic = FALSE; } - else - { - dynamic = TRUE; - do - { - fprintf(stderr,"Matrix: rows cols:"); - if ( fgets(line,MAXLINE,fp)==NULL ) - error(E_INPUT,"im_finput"); - } while ( sscanf(line,"%u%u",&m,&n)<2 || m>MAXDIM || n>MAXDIM ); - mat = m_get(m,n); - } - - /* input elements */ - for ( i=0; ime[i][j]); - if ( fgets(line,MAXLINE,fp)==NULL ) - error(E_INPUT,"im_finput"); - if ( (*line == 'b' || *line == 'B') && j > 0 ) - { j--; dynamic = FALSE; goto redo2; } - if ( (*line == 'f' || *line == 'F') && j < n-1 ) - { j++; dynamic = FALSE; goto redo2; } -#if REAL == DOUBLE - } while ( *line=='\0' || sscanf(line,"%lf",&mat->me[i][j])<1 ); -#elif REAL == FLOAT - } while ( *line=='\0' || sscanf(line,"%f",&mat->me[i][j])<1 ); -#endif - fprintf(stderr,"Continue: "); - fscanf(fp,"%c",&c); - if ( c == 'n' || c == 'N' ) - { dynamic = FALSE; goto redo; } - if ( (c == 'b' || c == 'B') /* && i > 0 */ ) - { if ( i > 0 ) - i--; - dynamic = FALSE; goto redo; - } - } - - return (mat); -} - -/* bm_finput -- batch-file input of matrix */ -MAT *bm_finput(fp,mat) -FILE *fp; -MAT *mat; -{ - u_int i,j,m,n,dummy; - int io_code; - - /* get dimension */ - skipjunk(fp); - if ((io_code=fscanf(fp," Matrix: %u by %u",&m,&n)) < 2 || - m>MAXDIM || n>MAXDIM ) - error(io_code==EOF ? E_EOF : E_FORMAT,"bm_finput"); - - /* allocate memory if necessary */ - if ( mat==(MAT *)NULL ) - mat = m_resize(mat,m,n); - - /* get entries */ - for ( i=0; ime[i][j])) < 1 ) -#elif REAL == FLOAT - if ((io_code=fscanf(fp,"%f",&mat->me[i][j])) < 1 ) -#endif - error(io_code==EOF ? 7 : 6,"bm_finput"); - } - - return (mat); -} - -PERM *px_finput(fp,px) -FILE *fp; -PERM *px; -{ - PERM *ipx_finput(),*bpx_finput(); - - if ( isatty(fileno(fp)) ) - return ipx_finput(fp,px); - else - return bpx_finput(fp,px); -} - - -/* ipx_finput -- interactive input of permutation */ -PERM *ipx_finput(fp,px) -FILE *fp; -PERM *px; -{ - u_int i,j,size,dynamic; /* dynamic set if memory allocated here */ - u_int entry,ok; - - /* get permutation size */ - if ( px!=(PERM *)NULL && px->sizesize; dynamic = FALSE; } - else - { - dynamic = TRUE; - do - { - fprintf(stderr,"Permutation: size: "); - if ( fgets(line,MAXLINE,fp)==NULL ) - error(E_INPUT,"ipx_finput"); - } while ( sscanf(line,"%u",&size)<1 || size>MAXDIM ); - px = px_get(size); - } - - /* get entries */ - i = 0; - while ( i%u new: ", - i,px->pe[i]); - if ( fgets(line,MAXLINE,fp)==NULL ) - error(E_INPUT,"ipx_finput"); - if ( (*line == 'b' || *line == 'B') && i > 0 ) - { i--; dynamic = FALSE; goto redo; } - } while ( *line=='\0' || sscanf(line,"%u",&entry) < 1 ); - /* check entry */ - ok = (entry < size); - for ( j=0; jpe[j]); - if ( ok ) - { - px->pe[i] = entry; - i++; - } - } - - return (px); -} - -/* bpx_finput -- batch-file input of permutation */ -PERM *bpx_finput(fp,px) -FILE *fp; -PERM *px; -{ - u_int i,j,size,entry,ok; - int io_code; - - /* get size of permutation */ - skipjunk(fp); - if ((io_code=fscanf(fp," Permutation: size:%u",&size)) < 1 || - size>MAXDIM ) - error(io_code==EOF ? 7 : 6,"bpx_finput"); - - /* allocate memory if necessary */ - if ( px==(PERM *)NULL || px->size %u",&entry)) < 1 ) - error(io_code==EOF ? 7 : 6,"bpx_finput"); - /* check entry */ - ok = (entry < size); - for ( j=0; jpe[j]); - if ( ok ) - { - px->pe[i] = entry; - i++; - } - else - error(E_BOUNDS,"bpx_finput"); - } - - return (px); -} - - -VEC *v_finput(fp,x) -FILE *fp; -VEC *x; -{ - VEC *ifin_vec(),*bfin_vec(); - - if ( isatty(fileno(fp)) ) - return ifin_vec(fp,x); - else - return bfin_vec(fp,x); -} - -/* ifin_vec -- interactive input of vector */ -VEC *ifin_vec(fp,vec) -FILE *fp; -VEC *vec; -{ - u_int i,dim,dynamic; /* dynamic set if memory allocated here */ - - /* get vector dimension */ - if ( vec != (VEC *)NULL && vec->dimdim; dynamic = FALSE; } - else - { - dynamic = TRUE; - do - { - fprintf(stderr,"Vector: dim: "); - if ( fgets(line,MAXLINE,fp)==NULL ) - error(E_INPUT,"ifin_vec"); - } while ( sscanf(line,"%u",&dim)<1 || dim>MAXDIM ); - vec = v_get(dim); - } - - /* input elements */ - for ( i=0; ive[i]); - if ( fgets(line,MAXLINE,fp)==NULL ) - error(E_INPUT,"ifin_vec"); - if ( (*line == 'b' || *line == 'B') && i > 0 ) - { i--; dynamic = FALSE; goto redo; } - if ( (*line == 'f' || *line == 'F') && i < dim-1 ) - { i++; dynamic = FALSE; goto redo; } -#if REAL == DOUBLE - } while ( *line=='\0' || sscanf(line,"%lf",&vec->ve[i]) < 1 ); -#elif REAL == FLOAT - } while ( *line=='\0' || sscanf(line,"%f",&vec->ve[i]) < 1 ); -#endif - - return (vec); -} - -/* bfin_vec -- batch-file input of vector */ -VEC *bfin_vec(fp,vec) -FILE *fp; -VEC *vec; -{ - u_int i,dim; - int io_code; - - /* get dimension */ - skipjunk(fp); - if ((io_code=fscanf(fp," Vector: dim:%u",&dim)) < 1 || - dim>MAXDIM ) - error(io_code==EOF ? 7 : 6,"bfin_vec"); - - /* allocate memory if necessary */ - if ( vec==(VEC *)NULL ) - vec = v_resize(vec,dim); - - /* get entries */ - skipjunk(fp); - for ( i=0; ive[i])) < 1 ) -#elif REAL == FLOAT - if ((io_code=fscanf(fp,"%f",&vec->ve[i])) < 1 ) -#endif - error(io_code==EOF ? 7 : 6,"bfin_vec"); - - return (vec); -} - -/************************************************************************** - Output routines - **************************************************************************/ -static char *format = "%14.9g "; - -char *setformat(f_string) -char *f_string; -{ - char *old_f_string; - old_f_string = format; - if ( f_string != (char *)NULL && *f_string != '\0' ) - format = f_string; - - return old_f_string; -} - -void m_foutput(fp,a) -FILE *fp; -MAT *a; -{ - u_int i, j, tmp; - - if ( a == (MAT *)NULL ) - { fprintf(fp,"Matrix: NULL\n"); return; } - fprintf(fp,"Matrix: %d by %d\n",a->m,a->n); - if ( a->me == (Real **)NULL ) - { fprintf(fp,"NULL\n"); return; } - for ( i=0; im; i++ ) /* for each row... */ - { - fprintf(fp,"row %u: ",i); - for ( j=0, tmp=2; jn; j++, tmp++ ) - { /* for each col in row... */ - fprintf(fp,format,a->me[i][j]); - if ( ! (tmp % 5) ) putc('\n',fp); - } - if ( tmp % 5 != 1 ) putc('\n',fp); - } -} - -void px_foutput(fp,px) -FILE *fp; -PERM *px; -{ - u_int i; - - if ( px == (PERM *)NULL ) - { fprintf(fp,"Permutation: NULL\n"); return; } - fprintf(fp,"Permutation: size: %u\n",px->size); - if ( px->pe == (u_int *)NULL ) - { fprintf(fp,"NULL\n"); return; } - for ( i=0; isize; i++ ) - if ( ! (i % 8) && i != 0 ) - fprintf(fp,"\n %u->%u ",i,px->pe[i]); - else - fprintf(fp,"%u->%u ",i,px->pe[i]); - fprintf(fp,"\n"); -} - -void v_foutput(fp,x) -FILE *fp; -VEC *x; -{ - u_int i, tmp; - - if ( x == (VEC *)NULL ) - { fprintf(fp,"Vector: NULL\n"); return; } - fprintf(fp,"Vector: dim: %d\n",x->dim); - if ( x->ve == (Real *)NULL ) - { fprintf(fp,"NULL\n"); return; } - for ( i=0, tmp=0; idim; i++, tmp++ ) - { - fprintf(fp,format,x->ve[i]); - if ( tmp % 5 == 4 ) putc('\n',fp); - } - if ( tmp % 5 != 0 ) putc('\n',fp); -} - - -void m_dump(fp,a) -FILE *fp; -MAT *a; -{ - u_int i, j, tmp; - - if ( a == (MAT *)NULL ) - { fprintf(fp,"Matrix: NULL\n"); return; } - fprintf(fp,"Matrix: %d by %d @ 0x%lx\n",a->m,a->n,(long)a); - fprintf(fp,"\tmax_m = %d, max_n = %d, max_size = %d\n", - a->max_m, a->max_n, a->max_size); - if ( a->me == (Real **)NULL ) - { fprintf(fp,"NULL\n"); return; } - fprintf(fp,"a->me @ 0x%lx\n",(long)(a->me)); - fprintf(fp,"a->base @ 0x%lx\n",(long)(a->base)); - for ( i=0; im; i++ ) /* for each row... */ - { - fprintf(fp,"row %u: @ 0x%lx ",i,(long)(a->me[i])); - for ( j=0, tmp=2; jn; j++, tmp++ ) - { /* for each col in row... */ - fprintf(fp,format,a->me[i][j]); - if ( ! (tmp % 5) ) putc('\n',fp); - } - if ( tmp % 5 != 1 ) putc('\n',fp); - } -} - -void px_dump(fp,px) -FILE *fp; -PERM *px; -{ - u_int i; - - if ( ! px ) - { fprintf(fp,"Permutation: NULL\n"); return; } - fprintf(fp,"Permutation: size: %u @ 0x%lx\n",px->size,(long)(px)); - if ( ! px->pe ) - { fprintf(fp,"NULL\n"); return; } - fprintf(fp,"px->pe @ 0x%lx\n",(long)(px->pe)); - for ( i=0; isize; i++ ) - fprintf(fp,"%u->%u ",i,px->pe[i]); - fprintf(fp,"\n"); -} - - -void v_dump(fp,x) -FILE *fp; -VEC *x; -{ - u_int i, tmp; - - if ( ! x ) - { fprintf(fp,"Vector: NULL\n"); return; } - fprintf(fp,"Vector: dim: %d @ 0x%lx\n",x->dim,(long)(x)); - if ( ! x->ve ) - { fprintf(fp,"NULL\n"); return; } - fprintf(fp,"x->ve @ 0x%lx\n",(long)(x->ve)); - for ( i=0, tmp=0; idim; i++, tmp++ ) - { - fprintf(fp,format,x->ve[i]); - if ( tmp % 5 == 4 ) putc('\n',fp); - } - if ( tmp % 5 != 0 ) putc('\n',fp); -} - //GO.SYSIN DD matrixio.c echo memory.c 1>&2 sed >memory.c <<'//GO.SYSIN DD memory.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* memory.c 1.3 11/25/87 */ - -#include "matrix.h" - - -static char rcsid[] = "$Id: m5,v 1.1.1.1 1999/04/14 14:16:22 borland Exp $"; - -/* m_get -- gets an mxn matrix (in MAT form) by dynamic memory allocation */ -MAT *m_get(m,n) -int m,n; -{ - MAT *matrix; - int i; - - if (m < 0 || n < 0) - error(E_NEG,"m_get"); - - if ((matrix=NEW(MAT)) == (MAT *)NULL ) - error(E_MEM,"m_get"); - else if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,0,sizeof(MAT)); - mem_numvar(TYPE_MAT,1); - } - - matrix->m = m; matrix->n = matrix->max_n = n; - matrix->max_m = m; matrix->max_size = m*n; -#ifndef SEGMENTED - if ((matrix->base = NEW_A(m*n,Real)) == (Real *)NULL ) - { - free(matrix); - error(E_MEM,"m_get"); - } - else if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,0,m*n*sizeof(Real)); - } -#else - matrix->base = (Real *)NULL; -#endif - if ((matrix->me = (Real **)calloc(m,sizeof(Real *))) == - (Real **)NULL ) - { free(matrix->base); free(matrix); - error(E_MEM,"m_get"); - } - else if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,0,m*sizeof(Real *)); - } - -#ifndef SEGMENTED - /* set up pointers */ - for ( i=0; ime[i] = &(matrix->base[i*n]); -#else - for ( i = 0; i < m; i++ ) - if ( (matrix->me[i]=NEW_A(n,Real)) == (Real *)NULL ) - error(E_MEM,"m_get"); - else if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,0,n*sizeof(Real)); - } -#endif - - return (matrix); -} - - -/* px_get -- gets a PERM of given 'size' by dynamic memory allocation - -- Note: initialized to the identity permutation */ -PERM *px_get(size) -int size; -{ - PERM *permute; - int i; - - if (size < 0) - error(E_NEG,"px_get"); - - if ((permute=NEW(PERM)) == (PERM *)NULL ) - error(E_MEM,"px_get"); - else if (mem_info_is_on()) { - mem_bytes(TYPE_PERM,0,sizeof(PERM)); - mem_numvar(TYPE_PERM,1); - } - - permute->size = permute->max_size = size; - if ((permute->pe = NEW_A(size,u_int)) == (u_int *)NULL ) - error(E_MEM,"px_get"); - else if (mem_info_is_on()) { - mem_bytes(TYPE_PERM,0,size*sizeof(u_int)); - } - - for ( i=0; ipe[i] = i; - - return (permute); -} - -/* v_get -- gets a VEC of dimension 'dim' - -- Note: initialized to zero */ -VEC *v_get(size) -int size; -{ - VEC *vector; - - if (size < 0) - error(E_NEG,"v_get"); - - if ((vector=NEW(VEC)) == (VEC *)NULL ) - error(E_MEM,"v_get"); - else if (mem_info_is_on()) { - mem_bytes(TYPE_VEC,0,sizeof(VEC)); - mem_numvar(TYPE_VEC,1); - } - - vector->dim = vector->max_dim = size; - if ((vector->ve=NEW_A(size,Real)) == (Real *)NULL ) - { - free(vector); - error(E_MEM,"v_get"); - } - else if (mem_info_is_on()) { - mem_bytes(TYPE_VEC,0,size*sizeof(Real)); - } - - return (vector); -} - -/* m_free -- returns MAT & asoociated memory back to memory heap */ -int m_free(mat) -MAT *mat; -{ -#ifdef SEGMENTED - int i; -#endif - - if ( mat==(MAT *)NULL || (int)(mat->m) < 0 || - (int)(mat->n) < 0 ) - /* don't trust it */ - return (-1); - -#ifndef SEGMENTED - if ( mat->base != (Real *)NULL ) { - if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,mat->max_m*mat->max_n*sizeof(Real),0); - } - free((char *)(mat->base)); - } -#else - for ( i = 0; i < mat->max_m; i++ ) - if ( mat->me[i] != (Real *)NULL ) { - if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,mat->max_n*sizeof(Real),0); - } - free((char *)(mat->me[i])); - } -#endif - if ( mat->me != (Real **)NULL ) { - if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,mat->max_m*sizeof(Real *),0); - } - free((char *)(mat->me)); - } - - if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,sizeof(MAT),0); - mem_numvar(TYPE_MAT,-1); - } - free((char *)mat); - - return (0); -} - - - -/* px_free -- returns PERM & asoociated memory back to memory heap */ -int px_free(px) -PERM *px; -{ - if ( px==(PERM *)NULL || (int)(px->size) < 0 ) - /* don't trust it */ - return (-1); - - if ( px->pe == (u_int *)NULL ) { - if (mem_info_is_on()) { - mem_bytes(TYPE_PERM,sizeof(PERM),0); - mem_numvar(TYPE_PERM,-1); - } - free((char *)px); - } - else - { - if (mem_info_is_on()) { - mem_bytes(TYPE_PERM,sizeof(PERM)+px->max_size*sizeof(u_int),0); - mem_numvar(TYPE_PERM,-1); - } - free((char *)px->pe); - free((char *)px); - } - - return (0); -} - - - -/* v_free -- returns VEC & asoociated memory back to memory heap */ -int v_free(vec) -VEC *vec; -{ - if ( vec==(VEC *)NULL || (int)(vec->dim) < 0 ) - /* don't trust it */ - return (-1); - - if ( vec->ve == (Real *)NULL ) { - if (mem_info_is_on()) { - mem_bytes(TYPE_VEC,sizeof(VEC),0); - mem_numvar(TYPE_VEC,-1); - } - free((char *)vec); - } - else - { - if (mem_info_is_on()) { - mem_bytes(TYPE_VEC,sizeof(VEC)+vec->max_dim*sizeof(Real),0); - mem_numvar(TYPE_VEC,-1); - } - free((char *)vec->ve); - free((char *)vec); - } - - return (0); -} - - - -/* m_resize -- returns the matrix A of size new_m x new_n; A is zeroed - -- if A == NULL on entry then the effect is equivalent to m_get() */ -MAT *m_resize(A,new_m,new_n) -MAT *A; -int new_m, new_n; -{ - int i; - int new_max_m, new_max_n, new_size, old_m, old_n; - - if (new_m < 0 || new_n < 0) - error(E_NEG,"m_resize"); - - if ( ! A ) - return m_get(new_m,new_n); - - /* nothing was changed */ - if (new_m == A->m && new_n == A->n) - return A; - - old_m = A->m; old_n = A->n; - if ( new_m > A->max_m ) - { /* re-allocate A->me */ - if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,A->max_m*sizeof(Real *), - new_m*sizeof(Real *)); - } - - A->me = RENEW(A->me,new_m,Real *); - if ( ! A->me ) - error(E_MEM,"m_resize"); - } - new_max_m = max(new_m,A->max_m); - new_max_n = max(new_n,A->max_n); - -#ifndef SEGMENTED - new_size = new_max_m*new_max_n; - if ( new_size > A->max_size ) - { /* re-allocate A->base */ - if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,A->max_m*A->max_n*sizeof(Real), - new_size*sizeof(Real)); - } - - A->base = RENEW(A->base,new_size,Real); - if ( ! A->base ) - error(E_MEM,"m_resize"); - A->max_size = new_size; - } - - /* now set up A->me[i] */ - for ( i = 0; i < new_m; i++ ) - A->me[i] = &(A->base[i*new_n]); - - /* now shift data in matrix */ - if ( old_n > new_n ) - { - for ( i = 1; i < min(old_m,new_m); i++ ) - MEM_COPY((char *)&(A->base[i*old_n]), - (char *)&(A->base[i*new_n]), - sizeof(Real)*new_n); - } - else if ( old_n < new_n ) - { - for ( i = (int)(min(old_m,new_m))-1; i > 0; i-- ) - { /* copy & then zero extra space */ - MEM_COPY((char *)&(A->base[i*old_n]), - (char *)&(A->base[i*new_n]), - sizeof(Real)*old_n); - __zero__(&(A->base[i*new_n+old_n]),(new_n-old_n)); - } - __zero__(&(A->base[old_n]),(new_n-old_n)); - A->max_n = new_n; - } - /* zero out the new rows.. */ - for ( i = old_m; i < new_m; i++ ) - __zero__(&(A->base[i*new_n]),new_n); -#else - if ( A->max_n < new_n ) - { - Real *tmp; - - for ( i = 0; i < A->max_m; i++ ) - { - if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,A->max_n*sizeof(Real), - new_max_n*sizeof(Real)); - } - - if ( (tmp = RENEW(A->me[i],new_max_n,Real)) == NULL ) - error(E_MEM,"m_resize"); - else { - A->me[i] = tmp; - } - } - for ( i = A->max_m; i < new_max_m; i++ ) - { - if ( (tmp = NEW_A(new_max_n,Real)) == NULL ) - error(E_MEM,"m_resize"); - else { - A->me[i] = tmp; - - if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,0,new_max_n*sizeof(Real)); - } - } - } - } - else if ( A->max_m < new_m ) - { - for ( i = A->max_m; i < new_m; i++ ) - if ( (A->me[i] = NEW_A(new_max_n,Real)) == NULL ) - error(E_MEM,"m_resize"); - else if (mem_info_is_on()) { - mem_bytes(TYPE_MAT,0,new_max_n*sizeof(Real)); - } - - } - - if ( old_n < new_n ) - { - for ( i = 0; i < old_m; i++ ) - __zero__(&(A->me[i][old_n]),new_n-old_n); - } - - /* zero out the new rows.. */ - for ( i = old_m; i < new_m; i++ ) - __zero__(A->me[i],new_n); -#endif - - A->max_m = new_max_m; - A->max_n = new_max_n; - A->max_size = A->max_m*A->max_n; - A->m = new_m; A->n = new_n; - - return A; -} - -/* px_resize -- returns the permutation px with size new_size - -- px is set to the identity permutation */ -PERM *px_resize(px,new_size) -PERM *px; -int new_size; -{ - int i; - - if (new_size < 0) - error(E_NEG,"px_resize"); - - if ( ! px ) - return px_get(new_size); - - /* nothing is changed */ - if (new_size == px->size) - return px; - - if ( new_size > px->max_size ) - { - if (mem_info_is_on()) { - mem_bytes(TYPE_PERM,px->max_size*sizeof(u_int), - new_size*sizeof(u_int)); - } - px->pe = RENEW(px->pe,new_size,u_int); - if ( ! px->pe ) - error(E_MEM,"px_resize"); - px->max_size = new_size; - } - if ( px->size <= new_size ) - /* extend permutation */ - for ( i = px->size; i < new_size; i++ ) - px->pe[i] = i; - else - for ( i = 0; i < new_size; i++ ) - px->pe[i] = i; - - px->size = new_size; - - return px; -} - -/* v_resize -- returns the vector x with dim new_dim - -- x is set to the zero vector */ -VEC *v_resize(x,new_dim) -VEC *x; -int new_dim; -{ - - if (new_dim < 0) - error(E_NEG,"v_resize"); - - if ( ! x ) - return v_get(new_dim); - - /* nothing is changed */ - if (new_dim == x->dim) - return x; - - if ( x->max_dim == 0 ) /* assume that it's from sub_vec */ - return v_get(new_dim); - - if ( new_dim > x->max_dim ) - { - if (mem_info_is_on()) { - mem_bytes(TYPE_VEC,x->max_dim*sizeof(Real), - new_dim*sizeof(Real)); - } - - x->ve = RENEW(x->ve,new_dim,Real); - if ( ! x->ve ) - error(E_MEM,"v_resize"); - x->max_dim = new_dim; - } - - if ( new_dim > x->dim ) - __zero__(&(x->ve[x->dim]),new_dim - x->dim); - x->dim = new_dim; - - return x; -} - - - - -/* Varying number of arguments */ -/* other functions of this type are in sparse.c and zmemory.c */ - - - -#ifdef ANSI_C - - -/* To allocate memory to many arguments. - The function should be called: - v_get_vars(dim,&x,&y,&z,...,NULL); - where - int dim; - VEC *x, *y, *z,...; - The last argument should be NULL ! - dim is the length of vectors x,y,z,... - returned value is equal to the number of allocated variables - Other gec_... functions are similar. -*/ - -int v_get_vars(int dim,...) -{ - va_list ap; - int i=0; - VEC **par; - - va_start(ap, dim); - while (par = va_arg(ap,VEC **)) { /* NULL ends the list*/ - *par = v_get(dim); - i++; - } - - va_end(ap); - return i; -} - - -int iv_get_vars(int dim,...) -{ - va_list ap; - int i=0; - IVEC **par; - - va_start(ap, dim); - while (par = va_arg(ap,IVEC **)) { /* NULL ends the list*/ - *par = iv_get(dim); - i++; - } - - va_end(ap); - return i; -} - -int m_get_vars(int m,int n,...) -{ - va_list ap; - int i=0; - MAT **par; - - va_start(ap, n); - while (par = va_arg(ap,MAT **)) { /* NULL ends the list*/ - *par = m_get(m,n); - i++; - } - - va_end(ap); - return i; -} - -int px_get_vars(int dim,...) -{ - va_list ap; - int i=0; - PERM **par; - - va_start(ap, dim); - while (par = va_arg(ap,PERM **)) { /* NULL ends the list*/ - *par = px_get(dim); - i++; - } - - va_end(ap); - return i; -} - - - -/* To resize memory for many arguments. - The function should be called: - v_resize_vars(new_dim,&x,&y,&z,...,NULL); - where - int new_dim; - VEC *x, *y, *z,...; - The last argument should be NULL ! - rdim is the resized length of vectors x,y,z,... - returned value is equal to the number of allocated variables. - If one of x,y,z,.. arguments is NULL then memory is allocated to this - argument. - Other *_resize_list() functions are similar. -*/ - -int v_resize_vars(int new_dim,...) -{ - va_list ap; - int i=0; - VEC **par; - - va_start(ap, new_dim); - while (par = va_arg(ap,VEC **)) { /* NULL ends the list*/ - *par = v_resize(*par,new_dim); - i++; - } - - va_end(ap); - return i; -} - - - -int iv_resize_vars(int new_dim,...) -{ - va_list ap; - int i=0; - IVEC **par; - - va_start(ap, new_dim); - while (par = va_arg(ap,IVEC **)) { /* NULL ends the list*/ - *par = iv_resize(*par,new_dim); - i++; - } - - va_end(ap); - return i; -} - -int m_resize_vars(int m,int n,...) -{ - va_list ap; - int i=0; - MAT **par; - - va_start(ap, n); - while (par = va_arg(ap,MAT **)) { /* NULL ends the list*/ - *par = m_resize(*par,m,n); - i++; - } - - va_end(ap); - return i; -} - - -int px_resize_vars(int new_dim,...) -{ - va_list ap; - int i=0; - PERM **par; - - va_start(ap, new_dim); - while (par = va_arg(ap,PERM **)) { /* NULL ends the list*/ - *par = px_resize(*par,new_dim); - i++; - } - - va_end(ap); - return i; -} - -/* To deallocate memory for many arguments. - The function should be called: - v_free_vars(&x,&y,&z,...,NULL); - where - VEC *x, *y, *z,...; - The last argument should be NULL ! - There must be at least one not NULL argument. - returned value is equal to the number of allocated variables. - Returned value of x,y,z,.. is VNULL. - Other *_free_list() functions are similar. -*/ - - -int v_free_vars(VEC **pv,...) -{ - va_list ap; - int i=1; - VEC **par; - - v_free(*pv); - *pv = VNULL; - va_start(ap, pv); - while (par = va_arg(ap,VEC **)) { /* NULL ends the list*/ - v_free(*par); - *par = VNULL; - i++; - } - - va_end(ap); - return i; -} - - -int iv_free_vars(IVEC **ipv,...) -{ - va_list ap; - int i=1; - IVEC **par; - - iv_free(*ipv); - *ipv = IVNULL; - va_start(ap, ipv); - while (par = va_arg(ap,IVEC **)) { /* NULL ends the list*/ - iv_free(*par); - *par = IVNULL; - i++; - } - - va_end(ap); - return i; -} - - -int px_free_vars(PERM **vpx,...) -{ - va_list ap; - int i=1; - PERM **par; - - px_free(*vpx); - *vpx = PNULL; - va_start(ap, vpx); - while (par = va_arg(ap,PERM **)) { /* NULL ends the list*/ - px_free(*par); - *par = PNULL; - i++; - } - - va_end(ap); - return i; -} - -int m_free_vars(MAT **va,...) -{ - va_list ap; - int i=1; - MAT **par; - - m_free(*va); - *va = MNULL; - va_start(ap, va); - while (par = va_arg(ap,MAT **)) { /* NULL ends the list*/ - m_free(*par); - *par = MNULL; - i++; - } - - va_end(ap); - return i; -} - - -#elif VARARGS -/* old varargs is used */ - - - -/* To allocate memory to many arguments. - The function should be called: - v_get_vars(dim,&x,&y,&z,...,VNULL); - where - int dim; - VEC *x, *y, *z,...; - The last argument should be VNULL ! - dim is the length of vectors x,y,z,... -*/ - -int v_get_vars(va_alist) va_dcl -{ - va_list ap; - int dim,i=0; - VEC **par; - - va_start(ap); - dim = va_arg(ap,int); - while (par = va_arg(ap,VEC **)) { /* NULL ends the list*/ - *par = v_get(dim); - i++; - } - - va_end(ap); - return i; -} - - -int iv_get_vars(va_alist) va_dcl -{ - va_list ap; - int i=0, dim; - IVEC **par; - - va_start(ap); - dim = va_arg(ap,int); - while (par = va_arg(ap,IVEC **)) { /* NULL ends the list*/ - *par = iv_get(dim); - i++; - } - - va_end(ap); - return i; -} - -int m_get_vars(va_alist) va_dcl -{ - va_list ap; - int i=0, n, m; - MAT **par; - - va_start(ap); - m = va_arg(ap,int); - n = va_arg(ap,int); - while (par = va_arg(ap,MAT **)) { /* NULL ends the list*/ - *par = m_get(m,n); - i++; - } - - va_end(ap); - return i; -} - - - -int px_get_vars(va_alist) va_dcl -{ - va_list ap; - int i=0, dim; - PERM **par; - - va_start(ap); - dim = va_arg(ap,int); - while (par = va_arg(ap,PERM **)) { /* NULL ends the list*/ - *par = px_get(dim); - i++; - } - - va_end(ap); - return i; -} - - - -/* To resize memory for many arguments. - The function should be called: - v_resize_vars(new_dim,&x,&y,&z,...,NULL); - where - int new_dim; - VEC *x, *y, *z,...; - The last argument should be NULL ! - rdim is the resized length of vectors x,y,z,... - returned value is equal to the number of allocated variables. - If one of x,y,z,.. arguments is NULL then memory is allocated to this - argument. - Other *_resize_list() functions are similar. -*/ - -int v_resize_vars(va_alist) va_dcl -{ - va_list ap; - int i=0, new_dim; - VEC **par; - - va_start(ap); - new_dim = va_arg(ap,int); - while (par = va_arg(ap,VEC **)) { /* NULL ends the list*/ - *par = v_resize(*par,new_dim); - i++; - } - - va_end(ap); - return i; -} - - - -int iv_resize_vars(va_alist) va_dcl -{ - va_list ap; - int i=0, new_dim; - IVEC **par; - - va_start(ap); - new_dim = va_arg(ap,int); - while (par = va_arg(ap,IVEC **)) { /* NULL ends the list*/ - *par = iv_resize(*par,new_dim); - i++; - } - - va_end(ap); - return i; -} - -int m_resize_vars(va_alist) va_dcl -{ - va_list ap; - int i=0, m, n; - MAT **par; - - va_start(ap); - m = va_arg(ap,int); - n = va_arg(ap,int); - while (par = va_arg(ap,MAT **)) { /* NULL ends the list*/ - *par = m_resize(*par,m,n); - i++; - } - - va_end(ap); - return i; -} - -int px_resize_vars(va_alist) va_dcl -{ - va_list ap; - int i=0, new_dim; - PERM **par; - - va_start(ap); - new_dim = va_arg(ap,int); - while (par = va_arg(ap,PERM **)) { /* NULL ends the list*/ - *par = px_resize(*par,new_dim); - i++; - } - - va_end(ap); - return i; -} - - -/* To deallocate memory for many arguments. - The function should be called: - v_free_vars(&x,&y,&z,...,NULL); - where - VEC *x, *y, *z,...; - The last argument should be NULL ! - returned value is equal to the number of allocated variables. - Returned value of x,y,z,.. is VNULL. - Other *_free_list() functions are similar. -*/ - - -int v_free_vars(va_alist) va_dcl -{ - va_list ap; - int i=0; - VEC **par; - - va_start(ap); - while (par = va_arg(ap,VEC **)) { /* NULL ends the list*/ - v_free(*par); - *par = VNULL; - i++; - } - - va_end(ap); - return i; -} - - - -int iv_free_vars(va_alist) va_dcl -{ - va_list ap; - int i=0; - IVEC **par; - - va_start(ap); - while (par = va_arg(ap,IVEC **)) { /* NULL ends the list*/ - iv_free(*par); - *par = IVNULL; - i++; - } - - va_end(ap); - return i; -} - - -int px_free_vars(va_alist) va_dcl -{ - va_list ap; - int i=0; - PERM **par; - - va_start(ap); - while (par = va_arg(ap,PERM **)) { /* NULL ends the list*/ - px_free(*par); - *par = PNULL; - i++; - } - - va_end(ap); - return i; -} - -int m_free_vars(va_alist) va_dcl -{ - va_list ap; - int i=0; - MAT **par; - - va_start(ap); - while (par = va_arg(ap,MAT **)) { /* NULL ends the list*/ - m_free(*par); - *par = MNULL; - i++; - } - - va_end(ap); - return i; -} - - - -#endif /* VARARGS */ - - //GO.SYSIN DD memory.c echo vecop.c 1>&2 sed >vecop.c <<'//GO.SYSIN DD vecop.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* vecop.c 1.3 8/18/87 */ - -#include -#include "matrix.h" - -static char rcsid[] = "$Id: m5,v 1.1.1.1 1999/04/14 14:16:22 borland Exp $"; - - -/* _in_prod -- inner product of two vectors from i0 downwards */ -double _in_prod(a,b,i0) -VEC *a,*b; -u_int i0; -{ - u_int limit; - /* Real *a_v, *b_v; */ - /* register Real sum; */ - - if ( a==(VEC *)NULL || b==(VEC *)NULL ) - error(E_NULL,"_in_prod"); - limit = min(a->dim,b->dim); - if ( i0 > limit ) - error(E_BOUNDS,"_in_prod"); - - return __ip__(&(a->ve[i0]),&(b->ve[i0]),(int)(limit-i0)); - /***************************************** - a_v = &(a->ve[i0]); b_v = &(b->ve[i0]); - for ( i=i0; idim != vector->dim ) - out = v_resize(out,vector->dim); - if ( scalar == 0.0 ) - return v_zero(out); - if ( scalar == 1.0 ) - return v_copy(vector,out); - - __smlt__(vector->ve,(double)scalar,out->ve,(int)(vector->dim)); - /************************************************** - dim = vector->dim; - out_ve = out->ve; vec_ve = vector->ve; - for ( i=0; ive[i] = scalar*vector->ve[i]; - (*out_ve++) = scalar*(*vec_ve++); - **************************************************/ - return (out); -} - -/* v_add -- vector addition -- may be in-situ */ -VEC *v_add(vec1,vec2,out) -VEC *vec1,*vec2,*out; -{ - u_int dim; - /* Real *out_ve, *vec1_ve, *vec2_ve; */ - - if ( vec1==(VEC *)NULL || vec2==(VEC *)NULL ) - error(E_NULL,"v_add"); - if ( vec1->dim != vec2->dim ) - error(E_SIZES,"v_add"); - if ( out==(VEC *)NULL || out->dim != vec1->dim ) - out = v_resize(out,vec1->dim); - dim = vec1->dim; - __add__(vec1->ve,vec2->ve,out->ve,(int)dim); - /************************************************************ - out_ve = out->ve; vec1_ve = vec1->ve; vec2_ve = vec2->ve; - for ( i=0; ive[i] = vec1->ve[i]+vec2->ve[i]; - (*out_ve++) = (*vec1_ve++) + (*vec2_ve++); - ************************************************************/ - - return (out); -} - -/* v_mltadd -- scalar/vector multiplication and addition - -- out = v1 + scale.v2 */ -VEC *v_mltadd(v1,v2,scale,out) -VEC *v1,*v2,*out; -double scale; -{ - /* register u_int dim, i; */ - /* Real *out_ve, *v1_ve, *v2_ve; */ - - if ( v1==(VEC *)NULL || v2==(VEC *)NULL ) - error(E_NULL,"v_mltadd"); - if ( v1->dim != v2->dim ) - error(E_SIZES,"v_mltadd"); - if ( scale == 0.0 ) - return v_copy(v1,out); - if ( scale == 1.0 ) - return v_add(v1,v2,out); - - if ( v2 != out ) - { - tracecatch(out = v_copy(v1,out),"v_mltadd"); - - /* dim = v1->dim; */ - __mltadd__(out->ve,v2->ve,scale,(int)(v1->dim)); - } - else - { - tracecatch(out = sv_mlt(scale,v2,out),"v_mltadd"); - out = v_add(v1,out,out); - } - /************************************************************ - out_ve = out->ve; v1_ve = v1->ve; v2_ve = v2->ve; - for ( i=0; i < dim ; i++ ) - out->ve[i] = v1->ve[i] + scale*v2->ve[i]; - (*out_ve++) = (*v1_ve++) + scale*(*v2_ve++); - ************************************************************/ - - return (out); -} - -/* v_sub -- vector subtraction -- may be in-situ */ -VEC *v_sub(vec1,vec2,out) -VEC *vec1,*vec2,*out; -{ - /* u_int i, dim; */ - /* Real *out_ve, *vec1_ve, *vec2_ve; */ - - if ( vec1==(VEC *)NULL || vec2==(VEC *)NULL ) - error(E_NULL,"v_sub"); - if ( vec1->dim != vec2->dim ) - error(E_SIZES,"v_sub"); - if ( out==(VEC *)NULL || out->dim != vec1->dim ) - out = v_resize(out,vec1->dim); - - __sub__(vec1->ve,vec2->ve,out->ve,(int)(vec1->dim)); - /************************************************************ - dim = vec1->dim; - out_ve = out->ve; vec1_ve = vec1->ve; vec2_ve = vec2->ve; - for ( i=0; ive[i] = vec1->ve[i]-vec2->ve[i]; - (*out_ve++) = (*vec1_ve++) - (*vec2_ve++); - ************************************************************/ - - return (out); -} - -/* v_map -- maps function f over components of x: out[i] = f(x[i]) - -- _v_map sets out[i] = f(params,x[i]) */ -VEC *v_map(f,x,out) -#ifdef PROTOTYPES_IN_STRUCT -double (*f)(double); -#else -double (*f)(); -#endif -VEC *x, *out; -{ - Real *x_ve, *out_ve; - int i, dim; - - if ( ! x || ! f ) - error(E_NULL,"v_map"); - if ( ! out || out->dim != x->dim ) - out = v_resize(out,x->dim); - - dim = x->dim; x_ve = x->ve; out_ve = out->ve; - for ( i = 0; i < dim; i++ ) - *out_ve++ = (*f)(*x_ve++); - - return out; -} - -VEC *_v_map(f,params,x,out) -#ifdef PROTOTYPES_IN_STRUCT -double (*f)(void *,double); -#else -double (*f)(); -#endif -VEC *x, *out; -void *params; -{ - Real *x_ve, *out_ve; - int i, dim; - - if ( ! x || ! f ) - error(E_NULL,"_v_map"); - if ( ! out || out->dim != x->dim ) - out = v_resize(out,x->dim); - - dim = x->dim; x_ve = x->ve; out_ve = out->ve; - for ( i = 0; i < dim; i++ ) - *out_ve++ = (*f)(params,*x_ve++); - - return out; -} - -/* v_lincomb -- returns sum_i a[i].v[i], a[i] real, v[i] vectors */ -VEC *v_lincomb(n,v,a,out) -int n; /* number of a's and v's */ -Real a[]; -VEC *v[], *out; -{ - int i; - - if ( ! a || ! v ) - error(E_NULL,"v_lincomb"); - if ( n <= 0 ) - return VNULL; - - for ( i = 1; i < n; i++ ) - if ( out == v[i] ) - error(E_INSITU,"v_lincomb"); - - out = sv_mlt(a[0],v[0],out); - for ( i = 1; i < n; i++ ) - { - if ( ! v[i] ) - error(E_NULL,"v_lincomb"); - if ( v[i]->dim != out->dim ) - error(E_SIZES,"v_lincomb"); - out = v_mltadd(out,v[i],a[i],out); - } - - return out; -} - - - -#ifdef ANSI_C - -/* v_linlist -- linear combinations taken from a list of arguments; - calling: - v_linlist(out,v1,a1,v2,a2,...,vn,an,NULL); - where vi are vectors (VEC *) and ai are numbers (double) -*/ -VEC *v_linlist(VEC *out,VEC *v1,double a1,...) -{ - va_list ap; - VEC *par; - double a_par; - - if ( ! v1 ) - return VNULL; - - va_start(ap, a1); - out = sv_mlt(a1,v1,out); - - while (par = va_arg(ap,VEC *)) { /* NULL ends the list*/ - a_par = va_arg(ap,double); - if (a_par == 0.0) continue; - if ( out == par ) - error(E_INSITU,"v_linlist"); - if ( out->dim != par->dim ) - error(E_SIZES,"v_linlist"); - - if (a_par == 1.0) - out = v_add(out,par,out); - else if (a_par == -1.0) - out = v_sub(out,par,out); - else - out = v_mltadd(out,par,a_par,out); - } - - va_end(ap); - return out; -} - -#elif VARARGS - - -/* v_linlist -- linear combinations taken from a list of arguments; - calling: - v_linlist(out,v1,a1,v2,a2,...,vn,an,NULL); - where vi are vectors (VEC *) and ai are numbers (double) -*/ -VEC *v_linlist(va_alist) va_dcl -{ - va_list ap; - VEC *par, *out; - double a_par; - - va_start(ap); - out = va_arg(ap,VEC *); - par = va_arg(ap,VEC *); - if ( ! par ) { - va_end(ap); - return VNULL; - } - - a_par = va_arg(ap,double); - out = sv_mlt(a_par,par,out); - - while (par = va_arg(ap,VEC *)) { /* NULL ends the list*/ - a_par = va_arg(ap,double); - if (a_par == 0.0) continue; - if ( out == par ) - error(E_INSITU,"v_linlist"); - if ( out->dim != par->dim ) - error(E_SIZES,"v_linlist"); - - if (a_par == 1.0) - out = v_add(out,par,out); - else if (a_par == -1.0) - out = v_sub(out,par,out); - else - out = v_mltadd(out,par,a_par,out); - } - - va_end(ap); - return out; -} - -#endif - - - - - -/* v_star -- computes componentwise (Hadamard) product of x1 and x2 - -- result out is returned */ -VEC *v_star(x1, x2, out) -VEC *x1, *x2, *out; -{ - int i; - - if ( ! x1 || ! x2 ) - error(E_NULL,"v_star"); - if ( x1->dim != x2->dim ) - error(E_SIZES,"v_star"); - out = v_resize(out,x1->dim); - - for ( i = 0; i < x1->dim; i++ ) - out->ve[i] = x1->ve[i] * x2->ve[i]; - - return out; -} - -/* v_slash -- computes componentwise ratio of x2 and x1 - -- out[i] = x2[i] / x1[i] - -- if x1[i] == 0 for some i, then raise E_SING error - -- result out is returned */ -VEC *v_slash(x1, x2, out) -VEC *x1, *x2, *out; -{ - int i; - Real tmp; - - if ( ! x1 || ! x2 ) - error(E_NULL,"v_slash"); - if ( x1->dim != x2->dim ) - error(E_SIZES,"v_slash"); - out = v_resize(out,x1->dim); - - for ( i = 0; i < x1->dim; i++ ) - { - tmp = x1->ve[i]; - if ( tmp == 0.0 ) - error(E_SING,"v_slash"); - out->ve[i] = x2->ve[i] / tmp; - } - - return out; -} - -/* v_min -- computes minimum component of x, which is returned - -- also sets min_idx to the index of this minimum */ -double v_min(x, min_idx) -VEC *x; -int *min_idx; -{ - int i, i_min; - Real min_val, tmp; - - if ( ! x ) - error(E_NULL,"v_min"); - if ( x->dim <= 0 ) - error(E_SIZES,"v_min"); - i_min = 0; - min_val = x->ve[0]; - for ( i = 1; i < x->dim; i++ ) - { - tmp = x->ve[i]; - if ( tmp < min_val ) - { - min_val = tmp; - i_min = i; - } - } - - if ( min_idx != NULL ) - *min_idx = i_min; - return min_val; -} - -/* v_max -- computes maximum component of x, which is returned - -- also sets max_idx to the index of this maximum */ -double v_max(x, max_idx) -VEC *x; -int *max_idx; -{ - int i, i_max; - Real max_val, tmp; - - if ( ! x ) - error(E_NULL,"v_max"); - if ( x->dim <= 0 ) - error(E_SIZES,"v_max"); - i_max = 0; - max_val = x->ve[0]; - for ( i = 1; i < x->dim; i++ ) - { - tmp = x->ve[i]; - if ( tmp > max_val ) bigmail CUT HERE............ test -w meschach1.shar && test -r 24048P04 && ( cat 24048P04 >> meschach1.shar; rm 24048P04 )